aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorBastien Guerry <[email protected]>2013-11-12 14:06:26 +0100
committerBastien Guerry <[email protected]>2013-11-12 14:06:26 +0100
commit271672fad74cdbc9065d23d6e6cee1b8540f571b (patch)
treed322b956ec0e74ee33b22354ef00839b23b1618d /lisp
parentf201cf3a8143b0b34b07769fc7d73dd14761b87b (diff)
Merge Org version 8.2.3a.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/org/ChangeLog5267
-rw-r--r--lisp/org/ob-C.el109
-rw-r--r--lisp/org/ob-R.el88
-rw-r--r--lisp/org/ob-abc.el94
-rw-r--r--lisp/org/ob-awk.el9
-rw-r--r--lisp/org/ob-calc.el1
-rw-r--r--lisp/org/ob-clojure.el5
-rw-r--r--lisp/org/ob-comint.el4
-rw-r--r--lisp/org/ob-core.el2778
-rw-r--r--lisp/org/ob-ditaa.el47
-rw-r--r--lisp/org/ob-dot.el1
-rw-r--r--lisp/org/ob-ebnf.el85
-rw-r--r--lisp/org/ob-emacs-lisp.el13
-rw-r--r--lisp/org/ob-eval.el196
-rw-r--r--lisp/org/ob-exp.el273
-rw-r--r--lisp/org/ob-fortran.el18
-rw-r--r--lisp/org/ob-gnuplot.el106
-rw-r--r--lisp/org/ob-haskell.el26
-rw-r--r--lisp/org/ob-io.el7
-rw-r--r--lisp/org/ob-java.el9
-rw-r--r--lisp/org/ob-js.el53
-rw-r--r--lisp/org/ob-keys.el2
-rw-r--r--lisp/org/ob-latex.el154
-rw-r--r--lisp/org/ob-lilypond.el9
-rw-r--r--lisp/org/ob-lisp.el4
-rw-r--r--lisp/org/ob-lob.el54
-rw-r--r--lisp/org/ob-makefile.el47
-rw-r--r--lisp/org/ob-maxima.el7
-rw-r--r--lisp/org/ob-mscgen.el1
-rw-r--r--lisp/org/ob-ocaml.el28
-rw-r--r--lisp/org/ob-octave.el6
-rw-r--r--lisp/org/ob-org.el16
-rw-r--r--lisp/org/ob-perl.el92
-rw-r--r--lisp/org/ob-picolisp.el13
-rw-r--r--lisp/org/ob-plantuml.el1
-rw-r--r--lisp/org/ob-python.el93
-rw-r--r--lisp/org/ob-ref.el9
-rw-r--r--lisp/org/ob-ruby.el81
-rw-r--r--lisp/org/ob-sass.el1
-rw-r--r--lisp/org/ob-scala.el7
-rw-r--r--lisp/org/ob-scheme.el206
-rw-r--r--lisp/org/ob-screen.el1
-rw-r--r--lisp/org/ob-sh.el11
-rw-r--r--lisp/org/ob-shen.el6
-rw-r--r--lisp/org/ob-sql.el100
-rw-r--r--lisp/org/ob-sqlite.el36
-rw-r--r--lisp/org/ob-table.el10
-rw-r--r--lisp/org/ob-tangle.el336
-rw-r--r--lisp/org/ob.el2566
-rw-r--r--lisp/org/org-agenda.el1692
-rw-r--r--lisp/org/org-archive.el13
-rw-r--r--lisp/org/org-attach.el51
-rw-r--r--lisp/org/org-bbdb.el11
-rw-r--r--lisp/org/org-bibtex.el49
-rw-r--r--lisp/org/org-capture.el221
-rw-r--r--lisp/org/org-clock.el444
-rw-r--r--lisp/org/org-colview.el36
-rw-r--r--lisp/org/org-compat.el79
-rw-r--r--lisp/org/org-crypt.el12
-rw-r--r--lisp/org/org-ctags.el9
-rw-r--r--lisp/org/org-datetree.el5
-rw-r--r--lisp/org/org-docview.el15
-rw-r--r--lisp/org/org-element.el2685
-rw-r--r--lisp/org/org-entities.el63
-rw-r--r--lisp/org/org-faces.el70
-rw-r--r--lisp/org/org-footnote.el165
-rw-r--r--lisp/org/org-gnus.el11
-rw-r--r--lisp/org/org-habit.el11
-rw-r--r--lisp/org/org-id.el14
-rw-r--r--lisp/org/org-indent.el109
-rw-r--r--lisp/org/org-inlinetask.el190
-rw-r--r--lisp/org/org-list.el329
-rw-r--r--lisp/org/org-macro.el191
-rw-r--r--lisp/org/org-macs.el78
-rw-r--r--lisp/org/org-mhe.el1
-rw-r--r--lisp/org/org-mobile.el57
-rw-r--r--lisp/org/org-mouse.el6
-rw-r--r--lisp/org/org-pcomplete.el175
-rw-r--r--lisp/org/org-plot.el1
-rw-r--r--lisp/org/org-protocol.el80
-rw-r--r--lisp/org/org-src.el110
-rw-r--r--lisp/org/org-table.el513
-rw-r--r--lisp/org/org-timer.el4
-rw-r--r--lisp/org/org-version.el4
-rw-r--r--lisp/org/org-w3m.el17
-rw-r--r--lisp/org/org.el6019
-rw-r--r--lisp/org/ox-ascii.el1973
-rw-r--r--lisp/org/ox-beamer.el1179
-rw-r--r--lisp/org/ox-html.el3427
-rw-r--r--lisp/org/ox-icalendar.el979
-rw-r--r--lisp/org/ox-latex.el2920
-rw-r--r--lisp/org/ox-man.el1260
-rw-r--r--lisp/org/ox-md.el483
-rw-r--r--lisp/org/ox-odt.el4413
-rw-r--r--lisp/org/ox-org.el255
-rw-r--r--lisp/org/ox-publish.el1238
-rw-r--r--lisp/org/ox-texinfo.el1891
-rw-r--r--lisp/org/ox.el6208
98 files changed, 44284 insertions, 8568 deletions
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog
index 019fa8a358..743053229b 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog
@@ -1,3 +1,5270 @@
+2013-11-12 Aaron Ecay <[email protected]>
+
+ * ox-latex.el (org-latex-inline-image-rules): Add "svg" to
+ supported filetypes.
+ (org-latex--inline-image): Implement SVG files inclusion.
+ (org-latex-headline): Don’t insert alternate title if identical to
+ regular one.
+
+ * ob-python.el: Update the arglist passed to `declare-function'
+ for `run-python'.
+
+ * ob-tangle.el (org-babel-tangle): Use 'light argument to
+ `org-babel-get-src-block-info'.
+
+ * ob-core.el (org-babel-execute-src-block): Return nil in case of
+ `:results none'. Also run `org-babel-after-execute-hook' in this
+ circumstance.
+
+ * org-id.el (org-id-locations-save): Bind print-(level,length) to
+ nil in this function.
+
+ * ob-R.el (org-babel-R-graphics-devices): New defvar.
+ (org-babel-R-construct-graphics-device-call): Use it instead of a
+ hard-coded list of graphics devices.
+
+ * ob-core.el (org-babel-when-in-src-block): New macro.
+ (org-babel-execute-src-block-maybe)
+ (org-babel-expand-src-block-maybe)
+ (org-babel-load-in-session-maybe, org-babel-pop-to-session-maybe):
+ Use it.
+ (org-babel-execute-src-block): Use `copy-tree' to prevent setf
+ from modifying users variables withing let-bound `info' variable.
+
+ * ob-exp.el (org-export-babel-evaluate): Add a 'inline-only
+ option.
+ (org-babel-exp-results): Implement 'inline-only for
+ `org-export-babel-evaluate'.
+
+ * org.el (org-edit-special): Use prefix arg.
+
+ * ob-awk.el (org-babel-expand-body:awk, ob-picolisp.el)
+ (org-babel-expand-body:picolisp): Remove optional arg.
+
+ * ob-R.el (org-babel-R-initiate-session): Handle case where the
+ session buffer exists, but does not have a live process.
+ (org-babel-R-construct-graphics-device-call): Change file
+ extension of tikz graphics files to .tikz.
+
+ * org-src.el (org-edit-src-exit): Don't modify the undo list when
+ inserting the code.
+
+ * ox-latex.el (org-latex-plain-text): Properly escape "~" for
+ LaTeX export.
+ (org-latex-image-default-option): Change default value to "".
+ (org-latex-image-default-width, org-latex-image-default-height):
+ New variables.
+ (org-latex-inline-image-rules): Make .tikz files as exportable
+ with LaTeX.
+ (org-latex--inline-image): Support tikz images. Also support
+ separate :width and :height parameters for images.
+
+ * org-bibtex.el (org-bibtex-ask): Use `visual-line-mode' instead
+ of longlines-mode.
+
+2013-11-12 Abdó Roig-Maranges <[email protected]>
+
+ * org.el (org-format-latex): Do not re-generate a LaTeX preview if
+ the image already exists.
+
+ * org-agenda.el (org-agenda-search-view-max-outline-level): New
+ option to define the max level for the entries shown by the search
+ view. A value of 1 means to show the top parent of the entries.
+
+ * org.el (org-create-formula-image-with-dvipng): Fix bug that made
+ this function fail with no :foreground and :background attributes
+ set, due to bad handling of "Transparent" color. Fix bug when
+ colors are not `default'.
+ (org-format-latex-options): Add `auto' to docstring.
+ (org-format-latex): Get face colors at point and put them inside
+ opt.
+ (org-create-formula-image-with-imagemagick): Fix bug when handling
+ "Transparent" bg color.
+ (org-dvipng-color-format): Same as `org-latex-color-format' for
+ dvipng-style color specification.
+
+2013-11-12 Achim Gratz <[email protected]>
+
+ * ob-core.el (org-babel-check-confirm-evaluate): Return result of
+ evaluating the function pointed to by `org-confirm-babel-evaluate'
+ when it is a functionp and its value as a variable otherwise.
+ (org-babel-get-rownames, org-table.el)
+ (org-table-transpose-table-at-point): Replace the inadvertent use
+ of mapcar* (from cl) by plain mapcar and direct cons manipulation.
+ (org-babel-params-from-properties): Use
+ `org-babel-current-src-block-location' for evaluating new-style
+ header-argument properties. Remove superfluous save-match-data
+ clauses. Comment which properties get evaluated where.
+ (org-babel-insert-header-arg, org-babel-parse-src-block-match):
+ Replace `if' with empty else part by `when' for readability.
+ (org-babel-params-from-properties): Inquire for language specific
+ and default header properties. Language specific header
+ properties take precedence over default header properties and
+ old-style header property specifications.
+
+ * org.el (org-re-property): Re-implement using full regex for
+ `org-re-property'. Add optional argument LITERAL to flag when
+ PROPERTY should to be regex-quoted. Move before definition of
+ `org-re-property'.
+ (org-re-property-keyword): Remove, functionality is subsumed by
+ `org-re-property'.
+ (org-property-re): Define using `org-re-property'. Improve
+ definition so that this regex can be
+ (org-entry-get, org-property-values): Adjust match number for
+ PROPVAL. (org-entry-put): Use `org-re-property' instead of
+ `org-re-property-keyword'.
+ used in all situations. Extend docstring with explanation of
+ matching groups.
+ (org-at-property-p): Implement using `org-element-at-point'.
+ (org-entry-properties, org-buffer-property-keys, org-indent-line):
+ Use `org-property-re' and adjust match group numbers accordingly.
+
+ * org-compat.el (define-obsolete-variable-alias)
+ (define-obsolete-function-alias): Actually remove the third (and
+ any following) argument from the argument list before calling the
+ advised function. Extend eval-and-compile clause and add advices
+ for functions that have different parameter lists in XEmacs. Add
+ variable definitions that XEmacs lacks .
+
+ * ob-fortran.el (org-every): Declare.
+
+ * org-element.el (org-element-node-property-parser): Use
+ `org-property-re' and adjust match group numbers accordingly.
+ Move `looking-at' out of the let clause to not rely on the
+ unspecified evaluation order inside the let.
+
+ * ob-eval.el, ob.el, org-macro.el, org-mhe.el: Require org-macs
+ and org-compat as necessary.
+
+ * ob-tangle.el (org-edit-special, org-store-link)
+ (org-open-link-from-string): Declare functions.
+
+ * org-macs.el (declare-function): Define macro to use autoload
+ instead for XEmacs.
+
+ * ox-html.el, ox-odt.el: XEmacs does not have table.el, so use
+ 'noerror on the require form.
+
+ * ox-texinfo.el (org-texinfo-table-column-widths): Fix spliced
+ argument list that XEmacs complains about by adding parenthesis.
+
+ * ob-octave.el (org-babel-octave-initiate-session): If octave-inf
+ can't be loaded, try octave instead before giving up. Emacs
+ 24.3.50 and upwards replaces octave-inf with just plain octave.
+
+ * org-id.el (org-id-update-id-locations): Autoload interactive
+ function.
+
+ * ob-core.el (org-babel-parse-inline-src-block-match):
+ * ob-exp.el (org-babel-exp-src-block): Give header arguments from
+ properties priority over default header arguments.
+
+ * ob-sh.el (org-babel-sh-var-to-sh): When detecting a table, the
+ first line could be the symbol `hline' rather than a list of table
+ cells, so check for that as well.
+
+ * org.el (org-table-clean-did-remove-column):
+ * org-table.el (org-table-clean-did-remove-column): Move defvar,
+ this dynamic variable is only used in org-table.
+
+ * org-table.el (org-table-colgroup-info): Remove unused defvar for
+ `org-table-colgroup-info'.
+ (org-table-clean-before-export): Let-bind regular expression
+ strings and remove unused matching group. Use
+ `org-table-clean-did-remove-column' in cond statement rather than
+ branching via if to avoid code duplication. Remove the code
+ associated with the removed `org-table-colgroup-info'.
+ (orgtbl-export): Remove unused internal function.
+
+ * org-macro.el (org-macro-expand): Do not try to interpret the
+ macro replacement text as a regex so that escaped backslashes and
+ commas in macro arguments will be interpreted correctly.
+
+ * ob-perl.el (org-babel-perl-wrapper-method): Select output handle
+ only after evaluation so that output is not mixed into results
+ eavaluation.
+ (org-babel-perl-evaluate): Fix the handling of results for
+ ":results output" to also parse tables. Use the same lambda
+ construction as in ob-sh.el to avoid code duplication.
+
+ * ob-exp.el (org-babel-exp-results, org-babel-lob-execute):
+ Suppress user confirmation of the emacs-lisp wrapper execution
+ around a lob call.
+
+ * ob-perl.el (org-babel-perl-wrapper-method): Use TAB as separator
+ for table results as expected by
+ `org-babel-import-elisp-from-file´.
+
+ * ob-core.el (org-babel-number-p): String match for any number
+ moved first so that the match data for the length check does not
+ become corrupted.
+ (org-babel-confirm-evaluate-answer-no): Dynamically scoped
+ variable, if bound non-nil the confirmation dialog will not be
+ initiated and denial of evaluation is assumed.
+ (org-babel-check-confirm-evaluate): New macro to establish
+ bindings based on INFO.
+ (org-babel-check-evaluate): New defsubst that checks if the
+ evaluation of a code block is disabled. Refactors the first part
+ of the original function `org-babel-confirm-evaluate´.
+ (org-babel-confirm-evaluate): New defsubst that checks if the user
+ should be queried and returns the answer. Keeps the second part
+ of the original function `org-babel-confirm-evaluate´.
+ Re-implement using bindings for common subexpressions.
+ (org-babel-execute-src-block): Do not ask for confirmation if the
+ cached result is current.
+ (org-babel-call-process-region-original): Change declaration into
+ definition with nil initial value at the beginning of the file and
+ drop the later definition. Add comment that the dynamic scoping
+ of this variable is done for tramp.
+
+ * org-table.el (org-table-eval-formula): The condition-case to
+ check for must be "error", not "user-error".
+
+ * ob-perl.el (org-babel-execute:perl): Pass `result-params´
+ through to `org-babel-perl-evaluate´.
+ (org-babel-variable-assignments:perl): Add "my" to variable
+ declaration so that it becomes compatible with "use strict;". Use
+ new internal formatting function `org-babel-perl--var-to-perl´.
+ (org-babel-perl--var-to-perl): New internal function, uses Perl
+ non-interpolating quoting on the string that defines the variable
+ to suppress spurious interpretation of it as Perl syntax.
+ (org-babel-perl-wrapper-method): Use a block and declare all
+ variables as "my", also use Perl quoting throughout. Redirect
+ STDOUT to the temporary file so that simply "print" will put the
+ results there. Check the return value and output in table form if
+ it is an ARRAY ref, otherwise print it without a final newline.
+ (org-babel-perl-preface): Content of this variable is prepended to
+ body before invocation of perl. Rename input parameter body to
+ ibody and let-bind body to concatentation of
+ `org-babel-perl-preface' and ibody. Implement results
+ interpretation so that tables are easier to produce.
+
+ * ob-eval.el (org-babel-eval): Use simplified version of
+ `org-babel--shell-command-on-region´, we are the only caller of
+ this function.
+ (org-babel--shell-command-on-region): Replace
+ `org-babel-shell-command-on-region´ with a much more simplified
+ internal version, remove superfluous DOCSTRING and interactive
+ clause, strip out all conditionals which were never used. Prevent
+ deletion of temporary input file to aid debugging when the symbol
+ `org-babel--debug-input´ is bound and has non-nil value.
+
+ * ob-tangle.el (org-babel-tangle): Do not change signature, a nil
+ arg is even documented in the manual.
+
+ * org-src.el: Change declaration of `org-babel-tangle´ to "arg"
+ for first argument.
+
+ * ob-core.el (org-babel-execute-src-block): Add binding for
+ merged-params to avoid multiple evaluation of
+ `org-babel-merge-params´. Rename cache? to cache-p, add binding
+ for cache-current-p and use it. Do not run
+ `org-babel-confirm-evaluate´ if source block has a cache and the
+ cache value is current (there is no evaluation involved in this
+ case).
+
+ * org.el (org-current-time): Replace call to obsolete function
+ `time-to-seconds´ with a call to compatibility function
+ `org-float-time´.
+
+ * org-compat.el (user-emacs-directory): If not bound, define as an
+ alias to `user-init-directory´ so that XEmacs continues to be
+ happy with Org.
+
+ * org-macs.el: New macro to allow the 5-argument form of load to
+ be used where possible without breaking compatibility with XEmacs.
+
+ * org.el (org-version, org-reload): Use
+ `org-load-noerror-mustsuffix´ instead of adding a fifth argument
+ to load directly. Guard against undefined variable load-suffixes,
+ which doesn't exist in XEmacs.
+
+ * org.el: Use
+ `org-define-obsolete-{function,variable}-alias´instead of
+ `define-obsolate{function,variable}-alias´.
+
+ * org-compat.el (user-error): Defalias to `error´ for Emacsen that
+ don't have it.
+
+ * ob-python.el (org-babel-python-hline-to)
+ (org-babel-python-None-to): Specify customize group as 'org-babel
+ and widget type as 'string.
+
+ * ob.el (org-babel-result-cond): Macro expansion needs to unquote
+ formal parameter `result-params´.
+
+ * org.el (org-reload): Major rewrite.
+
+ * org.el (org-clock-get-last-clock-out-time): Declare function.
+
+2013-11-12 Alan Schmitt <[email protected]>
+
+ * ob-ocaml.el (org-babel-prep-session:ocaml): Use
+ `save-window-excursion' around the code starting the tuareg
+ process.
+ (org-babel-ocaml-command): New option to specify the name of the
+ toplevel to run.
+ (org-babel-prep-session:ocaml): Directly call
+ `tuareg-run-process-if-needed' with `org-babel-ocaml-command' as
+ argument.
+ (org-babel-execute:ocaml): Always append ";;" at the end of the
+ expression before sending it to the toplevel. Do not remove the
+ type information if "verbatim" is a results parameter of the code
+ block.
+ (org-babel-ocaml-parse-output): Make sure the complete type is
+ taken into account when matching against known types.
+
+ * org-faces.el (org-footnote): Fix docstring.
+
+2013-11-12 Andreas Leha <[email protected]>
+
+ * ob-latex.el (org-babel-execute:latex): Add a tizk option that
+ copies the body of the block into a tikz file.
+
+2013-11-12 Arun Persaud <[email protected]>
+
+ * org-agenda.el (org-agenda-prefix-format): Add documentation for
+ the new %b option.
+ (org-prefix-has-breadcrumbs): Add flag, `t' when %b is set.
+ (org-agenda-format-item): Add breadcrumbs if requested.
+ (org-compile-prefix-format): Add compiled information for
+ breadcrumbs, add %b option.
+
+2013-11-12 Aurélien Aptel <[email protected]> (tiny change)
+
+ * ox-html.el (org-html-code, org-html-verbatim): Remove fancy
+ string replacements for code and verbatim text when exporting to
+ HTML.
+
+2013-11-12 Bastien Guerry <[email protected]>
+
+ * org.el (org-align-tags-here): Fix bug: move to the correct
+ position.
+ (org-agenda-prepare-buffers): Restore the point position.
+ (org-insert-link): Don't remove brackets when they belong to a
+ timestamp in a headline.
+
+ * org-capture.el (org-capture-refile): Don't finalize prematurely.
+ (org-capture): Store :return-to-wconf earlier.
+ (org-capture-place-template): Don't store :return-to-wconf when
+ called from a capture template using `function', rely on the early
+ :return-to-wconf value store from `org-capture'.
+
+ * org-compat.el (org-move-to-column): New argument
+ `ignore-invisible' to turn on `buffer-invisibility-spec'.
+
+ * org-agenda.el (org-agenda-show-new-time): Ignore invisible text
+ when inserting the new time as a text property.
+ (org-agenda-filter-make-matcher): When filtering tags and hitting
+ space, filter out entries with tags, only keep those without tags.
+ (org-agenda-drag-line-forward, org-agenda-drag-line-backward): Fix
+ bugs: don't drag lines without text and don't drag lines
+ before/after hidden lines.
+
+ * ox-odt.el (org-odt-table-style-format): Use %s for inserting the
+ rel-width property as a string.
+ (org-odt-template): Fall back on a string for :rel-width.
+
+ * org.el (org-directory, org-default-notes-file)
+ (org-reverse-note-order): Don't use the `org-remember'
+ customization group.
+ (org-require-autoloaded-modules): Don't require
+ `org-remember'.
+
+ * org-capture.el: Update commentary section to reflect the fact
+ that org-remember.el is not used anymore.
+
+ * org.el (org-babel-load-file): Set `exported-file' correctly, in
+ case the file as been tangled using a buffer-local value.
+
+ * ob-tangle.el (org-babel-tangle-file): Return the list of tangled
+ files.
+
+ * ox-org.el (org-org-publish-to-org): When htmlizing an .org file,
+ ensure to show all headings and all blocks before fontifying.
+
+ * ob-shen.el (org-babel-ruby-var-to-ruby): Declare.
+
+ * ox.el: Fix comment: remove reference to the obsolete variable
+ `org-export-language-setup'.
+
+ * org.el (org-set-regexps-and-options-for-tags): Fix concatenation
+ of the tags list.
+
+ * ox-odt.el (org-odt-pixels-per-inch): Use 96.0 as the default.
+
+ * org.el (org-refile): With a numeric prefix argument of `3',
+ emulate (setq org-refile-keep t) and copy the subtree to the
+ target location, don't delete it.
+ (org-set-regexps-and-options-for-tags): Fix the setting of tag
+ groups when relying on `org-tag-alist', not on tags directly set
+ in the buffer with the #+TAGS option.
+
+ * org-agenda.el (org-agenda-archive-with): Save window excursion.
+
+ * org.el (org-forward-element, org-backward-element): Throw a
+ message instead of an error when trying to move from a position
+ where there is no element.
+ (org-clock-is-active): Fix docstring.
+
+ * org-list.el (org-sort-list): Use `x' instead of `c' for sorting
+ plain list by checked status.
+
+ * org.el (org-structure-template-alist): Fix custom type and
+ default value.
+ (org-set-regexps-and-options-for-tags): Enhance docstring.
+ (org-set-regexps-and-options): Make sure not to add
+ `org-tag-alist' twice when setting this variable through et
+ #+setupfile: directive.
+ (org-tags-expand): Use `with-syntax-table'.
+
+ * org-list.el (org-sort-list): Implement sorting by "checked"
+ status for check lists.
+
+ * org-table.el (org-table-sum): Fix rounding error when summing
+ times.
+
+ * ob-scheme.el (org-babel-scheme-execute-with-geiser): Fix code
+ typo. Add declarations.
+
+ * ox-html.el (org-html-link-use-abs-url): New option.
+ (org-html-link): Use it to prepend relative links with the value
+ of HTML_LINK_HOME, when defined.
+
+ * org.el (org-refile): Fix refiling the active region within an
+ list. Don't store the last refiled subtree in the kill ring.
+
+ * org.el (org-mode-map): Remap `forward-paragraph' and
+ `backward-paragraph' to `org-forward-element' and
+ `org-backward-element'.
+
+ * ox-html.el (org-html-begin-plain-list): New parameter
+ `ordered-num' to tell whether the list is ordered numerically.
+ (org-html-plain-list): Handle alphabetical ordered list.
+
+ * org-agenda.el (org-batch-agenda): Let-bind `org-agenda-sticky'
+ to nil during batch export.
+
+ * org.el (org-copy-subtree): Fix typo in docstring.
+ (org-scan-tags): Don't disable `case-fold-search' too early.
+
+ * org-agenda.el (org-agenda-skip-eval): Fix typo in docstring.
+
+ * org-capture.el (org-capture-set-target-location): Don't throw an
+ error when `org-time-was-given' is not bound.
+
+ * org-clock.el (org-clock-modify-effort-estimate): Clarify
+ docstring.
+
+ * org.el (org-set-regexps-and-options-for-tags): Return a list
+ with tag-related variables.
+ (org-set-regexps-and-options): Append tags from a setup file to
+ the local tags of the file.
+ (org-agenda-prepare-buffers): Set tags from a setup file by
+ calling `org-set-regexps-and-options' when necessary.
+ (org-set-regexps-and-options): Fix `org-deadline-time-hour-regexp'
+ and `org-scheduled-time-hour-regexp'.
+
+ * org-table.el (org-table-TBLFM-begin-regexp): Rename from
+ `org-TBLFM-begin-regexp'.
+ (org-table-calc-current-TBLFM): Rename from
+ `org-calc-current-TBLFM'.
+
+ * org.el (org-ctrl-c-ctrl-c): Require org-table if needed.
+ (org-refresh-properties): Put the text property on the whole
+ subtree, not just on the headline.
+ (org-get-outline-path): Remove statistical and checkboxes cookies.
+
+ * org-agenda.el (org-agenda, org-search-view, org-tags-view)
+ (org-agenda-get-day-entries, org-agenda-set-restriction-lock): Use
+ (current-buffer) as the value of `org-agenda-restrict'. Fix a bug
+ about narrowing to wrong region boundaries when
+ `org-agenda-restrict' is non-nil.
+
+ * org.el (org-agenda-text-search-extra-files): Fix typos in
+ docstring.
+ (org-insert-heading): Fix case when there the first heading starts
+ at the beginning of the buffer.
+
+ * ob-core.el (org-babel-expand-src-block): Use
+ `org-called-interactively-p'.
+
+ * org.el (org-agenda-prepare-buffers): Avoid duplicates in
+ `org-tag-alist-for-agenda' correctly.
+ (org-read-date-minibuffer-local-map): Check if we are at the
+ beginning of the prompt, not if we are after a whitespace. Bind
+ C-. to `calendar-goto-today'.
+
+ * org-clock.el (org-clock-in): Don't forward by one character when
+ setting the marker in the clock history.
+
+ * org.el (org-read-date-minibuffer-local-map): Call
+ `calendar-goto-today' only if there is a space before point in the
+ minibuffer prompt.
+ (org-insert-heading): Reveal context when called interactively.
+ Fix bug about wrong conversion of lines with :END: or #+end_ into
+ headlines.
+ (org-in-drawer-p): New function.
+ (org-meta-return): Use `org-catch-invisible-edits' and the
+ `org-in-drawer-p' to check whether we are within a drawer.
+
+ * org-list.el (org-sort-list): Fix infloop.
+
+ * org.el (org-clone-subtree-with-time-shift): Unconditionally ask
+ for a time shift if there is a time-stamp. Don't ask for a time
+ shift when called with a universal prefix argument.
+
+ * ob-core.el (org-babel-insert-result): Fix bug when inserting
+ results as a list: ensure we split a string containing "\n".
+
+ * ox-html.el: Fix copyright header.
+
+ * org.el (org-store-link): Don't add a search string when storing
+ a link from a radio target.
+ (org-open-at-point): Jump to the radio link (<<<radio>>>), not to
+ the simple target (<<target>>).
+
+ * org-table.el (org-table-get-remote-range): Fix typo.
+
+ * org-datetree.el (org-datetree-find-month-create)
+ (org-datetree-find-day-create): Add a docstring.
+ (org-datetree-find-year-create): Only match headlines with a
+ year or a year and one or more tags.
+
+ * org-crypt.el (org-crypt-check-auto-save)
+ (org-crypt-use-before-save-magic): Use `org-add-hook' when the
+ hooks are local hooks.
+
+ * org-agenda.el (org-agenda-mode): Use `org-add-hook' and merge
+ upstream change from Emacs 2013-04-18T00:12:[email protected].
+
+ * ob-core.el (org-babel-pop-to-session-maybe): Fix docstring.
+ (org-babel-pop-to-session-maybe): Use true function's name,
+ not its alias.
+
+ * org-agenda.el (org-agenda-drag-line-forward)
+ (org-agenda-drag-line-backward): New commands.
+ (org-agenda-mode-map): Bind the new commands to M-<down> and
+ M-<up> respectively.
+
+ * org.el (org-insert-heading): Fix insertion of items.
+
+ * org-capture.el (org-capture-use-agenda-date): Fix docstring.
+
+ * org-agenda.el (org-agenda-bulk-toggle): Fix docstring.
+ (org-agenda-bulk-toggle-all): New command.
+ (org-agenda-mode-map): Bind `org-agenda-bulk-toggle' to `M-m'
+ and `org-agenda-bulk-toggle-all' to `M-*'.
+ (org-agenda-menu): Add `org-agenda-bulk-toggle' and
+ `org-agenda-bulk-toggle-all'.
+ (org-agenda-bulk-mark, org-agenda-bulk-unmark): Jump to the
+ next headline, not the next line.
+
+ * org-capture.el (org-mks): Fix bug: let-bind `case-fold-search'
+ to nil while matching the first letter of a multi-letters
+ template.
+
+ * org.el (org-store-link): When a bracket link is found in a
+ headline, use the link description or the link path.
+ (org-flag-drawer, org-hide-block-toggle)
+ (org-goto-left, org-goto-right, org-promote)
+ (org-paste-subtree, org-narrow-to-block, org-sort-entries)
+ (org-insert-link, org-offer-links-in-entry, org-open-file)
+ (org-refile, org-refile-get-location)
+ (org-refile-check-position, org-prepare-dblock, org-todo)
+ (org-auto-repeat-maybe, org-show-todo-tree, org-sparse-tree)
+ (org-occur, org-priority, org-scan-tags)
+ (org-get-tags-string, org-property-action, org-set-effort)
+ (org-entry-put, org-insert-drawer)
+ (org-compute-property-at-point)
+ (org-property-next-allowed-value, org-evaluate-time-range)
+ (org-closest-date, org-timestamp-change)
+ (org-revert-all-org-buffers, org-cycle-agenda-files)
+ (org-agenda-file-to-front, org-remove-file)
+ (org-preview-latex-fragment, org-format-latex)
+ (org-create-math-formula, org-create-formula-image)
+ (org-speed-command-help, org-check-before-invisible-edit)
+ (org-modifier-cursor-error, org-hidden-tree-error)
+ (org-mark-subtree, org-kill-line, org-first-sibling-p)
+ (org-up-element, org-down-element)
+ (org-drag-element-backward, org-drag-element-forward)
+ (org-unindent-buffer, org-speedbar-set-agenda-restriction): Use
+ `user-error' instead of `error'.
+
+ * ox-latex.el (latex): Don't force exporting with smart quotes.
+
+ * ox.el (org-export-with-smart-quotes): Mention the need to use
+ the relevant Babel package when setting this option to non-nil.
+
+ * org-src.el (org-edit-src-turn-on-auto-save): New option.
+ (org-edit-src-code): Use it.
+ (org-edit-src-auto-save-idle-delay): Enhance docstring.
+
+ * org-capture.el (org-mks): Make cursor invisible.
+
+ * org.el (org-link-expand-abbrev): Save match data before before
+ calling the replacement function.
+
+ * org-list.el (org-sort-list): Don't move point when matching time
+ values.
+
+ * org.el (org-shifttab): Show the correct number of empty
+ headlines when called with a numeric prefix argument. Enhance
+ docstring.
+ (org-uniquify): Use `copy-sequence'.
+ (org-adaptive-fill-function, org-fill-paragraph): Throw a useful
+ error message when parse an element fails in the current buffer.
+
+ * ox.el (org-export-with-planning): Enhance docstring.
+
+ * org.el (org-closed-keep-when-no-todo): New option.
+ (org-todo): Use the new option.
+ (org-open-line): Rename from `org-ctrl-o'.
+ (org-mode-map): Use `remap'.
+ (org-cycle-emulate-tab, org-file-apps)
+ (org-set-font-lock-defaults)
+ (org-translate-link-from-planner, org-link-search)
+ (org-refile-get-targets, org-read-date-get-relative): Minor
+ code clean-up: fix dangling parentheses.
+
+ * org-agenda.el (org-agenda-entry-text-mode): Also check against
+ regexp filters.
+ (org-timeline): Handle `org-agenda-show-log'.
+
+ * org-clock.el (org-clock-select-task): Remove successive
+ duplicates in the clock history to consider.
+
+ * org.el (org-uniquify-alist): Improve docstring.
+ (org-make-tags-matcher, org-change-tag-in-region): Add buffer's
+ tags to the tags completion table.
+ (org-tags-expand): Prevent circular replacement of group tags.
+ Tiny docstring formatting.
+ (org-uniquify): Make a defsubst. Use `delete-dups' instead of
+ `add-to-list'.
+ (org-todo): Also remove the CLOSED planning information when
+ removing the TODO keyword.
+ (org-forward-heading-same-level): Fix bug when forwarding
+ to a hidden subtree of the same level.
+ (org-tags-expand): Use word delimiters when building the tag
+ search regexp.
+
+ * org-clock.el (org-clock-insert-selection-line): Don't display
+ the clockout time.
+
+ * org.el (org-emphasis-regexp-components): Make a defvar.
+ (org-emphasis-alist): New default value: don't set HTML tags.
+ (org-emphasize, org-set-emph-re): Use the new value of
+ `org-emphasis-alist'.
+
+ * org-mobile.el (org-mobile-edit): Insert new headings at the end
+ of the parent subtree. Use `org-at-heading-p' instead of the
+ obsolete `org-on-heading-p'.
+
+ * org.el (org-insert-heading): When called from a list item and
+ `org-insert-heading-respect-content' is non-nil, insert a heading,
+ not an item.
+ (org-insert-heading-respect-content): Fix docstring.
+ (org-insert-heading): When in a non-empty non-headline line,
+ convert the current line into a headline.
+
+ * org-table.el (org-table-copy-down): Don't move cursor when
+ getting the field.
+
+ * ox-icalendar.el (org-icalendar-export-current-agenda): Do not
+ evaluate babel code blocks.
+
+ * ox-html.el (html): Add more options.
+
+ * ox-publish.el (org-publish-project-alist): Add :with-planning in
+ docstring.
+
+ * ob-exp.el (org-babel-exp-src-block): Tiny docstring fix.
+
+ * ox-icalendar.el (org-icalendar--combine-files): Fix typo.
+
+ * org-mouse.el (org-mouse-agenda-context-menu): Fix a function's
+ name.
+
+ * ox.el (org-export-options-alist, org-export--skip-p): Use
+ `:with-planning' instead of `:with-plannings', to keep in sync
+ with the corresponding option's name.
+
+ * ob-core.el (org-babel-confirm-evaluate): Fix typo in docstring.
+
+ * org-agenda.el (org-agenda-undo, org-agenda)
+ (org-agenda-append-agenda)
+ (org-agenda-get-restriction-and-command, org-agenda-write)
+ (org-agenda-clock-cancel)
+ (org-agenda-diary-entry-in-org-file, org-agenda-diary-entry)
+ (org-agenda-execute-calendar-command)
+ (org-agenda-goto-calendar, org-agenda-convert-date)
+ (org-agenda-bulk-mark, org-agenda-bulk-action)
+ (org-agenda-show-the-flagging-note): Use `user-error' instead of
+ `error'.
+
+ * org-macs.el (org-with-remote-undo): Normalize argument names.
+
+ * org.el (org-store-log-note): Fix `buffer-undo-list' when called
+ after `org-agenda-todo'.
+ (org-add-log-note): Minor formatting fix.
+
+ * org-agenda.el (org-agenda-append-agenda): Set buffer read only.
+
+ * org-clock.el (org-clock-select-task): Throw a user error when
+ the clock history is empty.
+
+ * org-table.el (org-table-get-remote-range): Fix docstring: use
+ #+NAME instead of #+TBLNAME.
+
+ * ob-ref.el: Use #+NAME instead of #+TBLNAME in comment.
+
+ * ox-html.el (org-html-table-row-tags): Better example.
+
+ * org-clock.el (org-clock-select-task): Fix window to buffer.
+ Hide the cursor.
+ (org-clock-insert-selection-line): Add the clock-out time.
+
+ * ox-html.el (org-html-table-row-tags): Allow new dynamically
+ bound value `row-number'.
+ (org-html-table-row): Bind `row-number' to the number of the
+ row (first row is 0).
+
+ * org.el (org-minutes-to-clocksum-string): Round fractions of
+ minutes.
+
+ * ox-html.el (org-html-table-row-tags): Fix example in docstring.
+
+ * org-agenda.el (org-agenda-span-to-ndays): Enhance docstring.
+ (org-agenda-goto-date): Fix bug when going to a date in month
+ view.
+ (org-agenda-goto-date): Put the cursor on the agenda line with the
+ selected date.
+ (scheduled/deadline items with hour spec) then redo an agenda*.
+
+ * org-clock.el (org-clock-resolve): Enhance the content of the
+ help window.
+
+ * org-footnote.el (org-footnote-auto-label): Minor docstring fix.
+
+ * ox-odt.el (org-odt-link): Fix bug: convert & to &amp; in
+ links.
+
+ * ox-html.el (org-html-table-row): Dynamically bind
+ `rowgroup-number', `start-rowgroup-p', `end-rowgroup-p',
+ `top-row-p', `bottom-row-p'.
+ (org-html-table-row-tags): Update docstring: tell what variables
+ are dynamically bound.
+
+ * org-src.el (org-edit-src-code): Don't set
+ `buffer-auto-save-file-name' unless `auto-save-default' is
+ non-nil.
+
+ * ox.el (org-export-table-row-group): Fix typo in docstring.
+
+ * org-table.el (orgtbl-apply-fmt): Enhance docstring.
+
+ * org.el (org-file-contents): Make the message more prominent.
+
+ * ox.el (org-export-replace-region-by): New function.
+
+ * ox-texinfo.el (org-texinfo-convert-region-to-texinfo),
+ * ox-md.el (org-md-convert-region-to-md),
+ * ox-latex.el (org-latex-convert-region-to-latex),
+ * ox-html.el (org-html-convert-region-to-html): New functions to
+ replace the active region by its export into various backends.
+
+ * org-faces.el (org-agenda-restriction-lock): Use less flashy
+ colors.
+
+ * org-agenda.el
+ (org-agenda-restriction-lock-highlight-subtree): New option.
+ (org-agenda-top-headline-filter): Rename from
+ `org-agenda-top-headline-filter'.
+ (org-find-top-headline): Rename from `org-find-top-category'.
+ Add a docstring.
+ (org-agenda-filtered-by-top-headline): Rename from
+ `org-agenda-filtered-by-top-category'.
+ (org-agenda-filter-by-top-headline): Rename from
+ `org-agenda-filter-by-top-category'. Fix docstring.
+ (org-agenda-filter-top-headline-apply): Rename from
+ `org-agenda-filter-top-category-apply'. Fix docstring.
+ (org-agenda-mode-map): Update binding.
+ (org-agenda-get-todos): Set `todo-state' earlier so that we can
+ skip false-positives in time.
+
+ * org.el (org-get-todo-state): Add a docstring.
+ (org-ctrl-o): New command to insert a new row in tables
+ (like `M-S-<down>' does) and open a line elsewhere.
+ (org-mode-map): Bind the new command to `C-o'.
+ (org-set-regexps-and-options): Process tags from an external setup
+ file.
+
+ * org-agenda.el (org-agenda-dim-blocked-tasks): Enhance docstring.
+ (org-agenda-finalize-entries): Conditionally apply limits so
+ that we don't manipulate big lists uselessly.
+ (org-agenda-limit-entries): Limit exclusively. E.g., when
+ limiting to a maximum of "2 tags", don't limit among tagged
+ entries only, but limit among all entries.
+ (org-agenda-limit-interactively): New command.
+ (org-agenda-mode-map): Bind the new command to "~".
+ (org-agenda-redo): Small fix: don't use `eval'.
+
+ * org.el (org-ctrl-c-ctrl-c): Fix bug wrt updating checkboxes: the
+ list beginning should be stored using a marker so that updating
+ [%0] to [%50] will not throw an error.
+ (org-babel-load-file): Move `org-babel-load-file' from
+ ob-tangle.el to here so that it is correctly autoloaded by Emacs
+ before Org is required.
+
+ * org-mac-message.el: Delete.
+
+ * org.el (org-modules): org-mac-message.el is not a core package
+ anymore.
+
+ * org-table.el (orgtbl-to-generic): Fix bug when exporting the
+ cells of radio tables with 'hline.
+
+ * org.el (org-speed-commands-default): Use ?s for
+ `org-narrow-to-subtree'.
+
+ * org-agenda.el (org-agenda-start-on-weekday): Fix typo.
+ (org-agenda-start-day): Enhance docstring.
+
+ * org-src.el (org-src-native-tab-command-maybe): Check that we are
+ in a source code block.
+
+ * org-mobile.el: Remove useless defvar.
+
+ * org.el (org-indent-line): A line just below a line with a list
+ item is now indented depending on the indentation of this list
+ item.
+
+ * org.el (org-options-keywords): Add #+TARGET.
+
+ * org-clock.el (org-resolve-clocks-if-idle): Only try to resolve
+ last clock if the clock buffer still exists.
+ (org-clock-out, org-clock-cancel): Set markers to nil.
+
+ * ox-org.el (org-org-publish-to-org):
+ * ox-html.el (org-html-publish-to-html): Use the custom extension.
+
+ * org.el (org-cycle-internal-local): Fix invalid search bound when
+ `org-cycle-include-plain-lists' is set to 'integrate.
+
+ * org.el (org-sparse-tree-default-date-type): Add an option for
+ closed time-stamps.
+ (org-sparse-tree): Allow to check against closed time-stamps.
+ (org-re-timestamp): Handle closed time-stamps.
+ (org-closed-in-range): Delete.
+
+ * org-capture.el (org-capture-import-remember-templates): Take
+ care of adding :jump-to-captured option if needed.
+
+ * org.el (org-toggle-pretty-entities): Enhance messages.
+ (org-raise-scripts): Handle scripts like "a_b^c".
+
+ * org-capture.el (org-capture-templates): Document new option
+ :jump-to-captured in the docstring. Offer the complete list of
+ options when customizing.
+ (org-capture-finalize): Handle :jump-to-captured.
+
+ * org.el (org-agenda-prepare-buffers): Fix bugs: don't let-bind
+ `org-tag-alist' to nil and don't append duplicate tags to
+ `org-tag-alist-for-agenda'.
+ (org-store-link): Storing multiple links in the active region now
+ requires a triple prefix argument.
+ (org-store-link, org-link-search): Fix handling of links to #+NAME
+ and #+TARGET keywords.
+
+ * org-compat.el (org-ignore-region): Tiny docstring fix.
+
+ * org-capture.el (org-capture): Don't store multiple links over
+ lines in the active region.
+
+ * ox-odt.el (org-odt-special-block): Don't wrap annotations into
+ <text:p>...</text:p> at all.
+ (org-odt--fix-annotations): New function.
+ (org-odt--export-wrap): Use the new function to fix annotations
+ insertion in content.xml.
+
+ * org.el (org-mode-flyspell-verify): Require 'org-element so that
+ `org-element-affiliated-keywords' is defined.
+
+ * ox-odt.el (org-odt-special-block): Don't insert annotations
+ using style "Text_20_body".
+
+ * org.el (org-toggle-tags-groups): Correctly highlight group tags.
+ (org-tags-expand): Expand tags as words, with characters ?@
+ and ?_ being considered words constituents.
+ (org-set-regexps-and-options): Don't read setup files from
+ read-only buffers.
+ (org-file-contents): When no-error is non-nil, throw a less
+ intrusive message.
+
+ * org-agenda.el (org-agenda-scheduled-leaders)
+ (org-agenda-deadline-leaders): Re-align leaders to the left,
+ back to a 11 characters width.
+
+ * org.el (org-refile-cache-check-set): More informative message.
+
+ * org-agenda.el (org-tags-view): Set the matcher after preparing
+ the agenda, as `org-tag-groups-alist-for-agenda' might be needed.
+ (org-agenda-filter-make-matcher): New parameter `filter' and
+ `type'. Handle group tags.
+ (org-agenda-filter-expand-tags): New function.
+ (org-agenda-filter-apply): Handle group tags.
+
+ * org.el (org-blank-before-new-entry): Tiny docstring fix.
+ (org-tag-alist-for-agenda): Add docstring.
+ (org-tag-groups-alist-for-agenda): New global variable.
+ (org-tag-groups-alist): New buffer-local variable.
+ (org-tag-alist, org-tag-persistent-alist): Handle :grouptags.
+ (org-group-tags): New option.
+ (org-toggle-group-tags): New command.
+ (org-mode-map): Bind `org-toggle-group-tags' to `C-c C-x q'.
+ (org-set-regexps-and-options-for-tags): New function, factored
+ out from `org-set-regexps-and-options'.
+ (org-set-regexps-and-options): Don't handle tags, they are now
+ handled separately by `org-set-regexps-and-options-for-tags'.
+ (org-assign-fast-keys): Handle :grouptags.
+ (org-mode): Use `org-set-regexps-and-options-for-tags' on top
+ of `org-set-regexps-and-options'.
+ (org-fontify-meta-lines-and-blocks-1): Fontify group tags.
+ (org-make-tags-matcher): Expand group tags in the matcher.
+ (org-tags-expand): New function.
+ (org-tags-completion-function): Tiny code clean up.
+ (org-set-current-tags-overlay): Add a docstring.
+ (org-fast-tag-selection): Highlight group tags.
+ (org-agenda-prepare-buffers): Set `org-tag-alist-for-agenda'
+ and `org-tag-groups-alist-for-agenda'. Don't uniquify
+ `org-tag-alist-for-agenda' as we may need the grouping
+ information for filtering in the agenda buffer.
+ (org-uniquify-alist): New function.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option/tags): Handle
+ :grouptags.
+
+ * org-faces.el (mode-line): New face for group tags.
+
+ * ob-core.el (org-babel-hash-show-time): Tiny docstring
+ enhancement.
+
+ * org-element.el (org-element-paragraph-separate): Use new name
+ `org-list-allow-alphabetical'.
+
+ * org-list.el (org-list-allow-alphabetical): Rename from
+ `org-alphabetical-lists'.
+ (org-list-empty-line-terminates-plain-lists): Rename from
+ `org-empty-line-terminates-plain-lists'.
+ (org-checkbox-hierarchical-statistics): Rename from
+ `org-hierarchical-checkbox-statistics'.
+
+ * org.el (org-image-actual-width): Update docstring.
+ (org-display-inline-images): Use the #+attr_html: :width syntax.
+ (org-modules): Remove deleted libraries, add new ones.
+
+ * ox-html.el (org-html-indent): Default to nil, as non-nil can
+ break indentation of source code blocks.
+ (org-html-link): Don't insert nil if there is no attributes.
+ (org-html-link--inline-image): Use the correct syntax for image
+ attributes. Allow :width :height and :alt as predefined
+ attributes for inline images.
+ (org-html-link, org-html-table): Use the standard syntax---
+ e.g. "#+attr_html: :options ..."--- to get attributes.
+
+ * ox.el (org-export-table-cell-alignment): Treat an empty cell as
+ a number if it follows a number.
+
+ * ox.el (org-export-as): Allow user functions in
+ `org-export-before-parsing-hook' to modify the point.
+
+ * org.el (org-entry-add-to-multivalued-property): Add the new
+ value by appending it at the end of the line.
+
+ * org-table.el (orgtbl-to-generic): New parameter `backend' to
+ export cells content using a specific backend.
+ (orgtbl-to-latex, orgtbl-to-texinfo): Export cells to LaTeX
+ and Texinfo before sending the table.
+
+ * ox.el (org-export-define-backend)
+ (org-export-define-derived-backend): Make defuns and update
+ docstrings.
+
+ * ox-texinfo.el (texinfo):
+ * ox-org.el (org):
+ * ox-odt.el (odt):
+ * ox-md.el (md):
+ * ox-man.el (man):
+ * ox-latex.el (latex):
+ * ox-icalendar.el (icalendar):
+ * ox-html.el (html):
+ * ox-beamer.el (beamer):
+ * ox-ascii.el (ascii): Use `org-export-define-backend' and
+ `org-export-define-derived-backend' as defuns, not macros.
+
+ * org.el (org-set-regexps-and-options): Use
+ `org-table-set-constants'.
+
+ * org-table.el (org-table-set-constants): New function.
+ (orgtbl-ctrl-c-ctrl-c): Use it.
+
+ * org-pcomplete.el
+ (pcomplete/org-mode/block-option/clocktable): Add parameters.
+
+ * org.el (org-options-keywords): Remove "INFOJS_OPT": it is added
+ through ox-html.el now.
+
+ * org-agenda.el (org-agenda-redo): Set filters after agenda has
+ been redone.
+
+ * org.el (org-store-link): When there is an active region, store
+ each line as a separate link.
+ (org-insert-all-links): Use a default description when links
+ do not have one already.
+
+ * org-agenda.el (org-agenda-redo): Fix code typo.
+
+ * org.el (org-link-display-format): Fix docstring.
+
+ * ox-publish.el (org-publish-org-to)
+ (org-publish-org-sitemap, org-publish-find-title)
+ (org-publish-find-date)
+ (org-publish-cache-file-needs-publishing): Set
+ `org-inhibit-startup' to t when visiting files for
+ publication.
+
+ * ox-org.el (org-org-publish-to-org): Kill buffers not visited at
+ publication time.
+
+ * org.el (org-set-font-lock-defaults): Set font-lock keywords
+ correctly for plain links.
+
+ * ox-texinfo.el (org-texinfo-logfiles-extensions)
+ (org-texinfo-remove-logfiles): New options.
+ (org-texinfo-compile): Use the new options to remove files
+ after compiling a Texinfo file.
+
+ * ox-texinfo.el (org-texinfo-coding-system): New option.
+ (org-texinfo-template): Add @documentlanguage and
+ @documentencoding.
+ (org-texinfo-headline): Add a space before tags.
+ (org-texinfo-export-to-texinfo, org-texinfo-export-to-info):
+ Use `org-texinfo-coding-system' as the coding system for
+ exported buffers.
+ (org-texinfo-publish-to-texinfo): New function.
+
+ * ox-texinfo.el (org-texinfo-filename)
+ (org-texinfo-info-process, org-texinfo-max-toc-depth)
+ (org-texinfo--sanitize-menu): Docstrings tiny fixes.
+
+ * org-agenda.el (org-agenda-dim-blocked-tasks): Only throw a
+ message when called interactively. Fix docstring position in the
+ defun.
+
+ * ox-html.el (org-html--build-meta-info): Fix setting of
+ http-equiv="Content-Type".
+
+ * org-agenda.el (org-agenda-mode-map): Use ?= for filtering by
+ regexp and ?| for removing all filters.
+ (org-agenda-filter-remove-all): New command.
+ (org-agenda-filter-show-all-re): Rename from
+ `org-agenda-filter-show-all-regexp'.
+ (org-agenda-filter-by-regexp): Call
+ `org-agenda-filter-show-all-re'.
+
+ * org-list.el (org-insert-item): Don't ask for a definition term
+ when insert an item in a description list.
+
+ * org-agenda.el (org-agenda-Quit): Set `org-agenda-buffer' to nil.
+ This prevents bugs when calling e.g., `org-diary' after quitting
+ an agenda window.
+ (org-agenda-entry-types): Move earlier in the file.
+ (org-agenda-custom-commands-local-options, org-diary)
+ (org-agenda-get-day-entries): Don't hardcode the default agenda
+ entry types, use `org-agenda-entry-types'.
+ (org-agenda-custom-commands): Fix default setting so that the
+ customize interface does not complain about a mismatch.
+
+ * org.el (org-export-backends): Add new backends.
+
+ * ox-html.el (org-html-indent): New option.
+ (org-html-use-unicode-chars): New option.
+ (org-html-pretty-output): Delete.
+ (org-html-final-function): Use the new options.
+
+ * ox-html.el (org-html-link): Fix handling of abbreviated links
+ which include a file: protocol.
+ (org-html--build-postamble): Default to today's date.
+ (org-html--build-meta-info): When #+DATE contains a time stamp,
+ parse it as a RFC 822 time string, otherwise simply insert the
+ date as a string.
+
+ * ox.el (org-export--copy-to-kill-ring-p): New function.
+ (org-export-copy-to-kill-ring): Use 'if-interactive as the
+ default.
+ (org-export-to-buffer, org-export-to-file): Use
+ `org-export--copy-to-kill-ring-p' and fix docstrings.
+
+ * ox-odt.el (org-odt-export-as-odf): Use
+ `org-export--copy-to-kill-ring-p'.
+
+ * org.el (org-set-font-lock-defaults): Fontify macros.
+
+ * org-faces.el (org-macro): New face.
+
+ * org.el (org-clone-subtree-with-time-shift): Only prompt for a
+ time shift when the entry at point has a time stamp and when the
+ command is called with a universal prefix argument.
+ (org-execute-file-search-functions): Docstring fix.
+
+ * org-compat.el (org-defvaralias): Fix declare form.
+
+ * org-clock.el (org-clocktable-defaults): Add :mstart parameter.
+ (org-clock-special-range): New argument mstart.
+ (org-dblock-write:clocktable, org-dblock-write:clocktable)
+ (org-clocktable-write-default, org-clocktable-steps)
+ (org-clock-get-table-data): Handle the :mstart parameter.
+
+ * org.el (org-map-entries): Use `save-window-excursion'.
+
+ * org-compat.el (org-defvaralias): New compatibility function.
+
+ * org-list.el (org-cycle-include-plain-lists): Also add to the
+ 'org-cycle customization group.
+ (org-list-allow-alphabetical)
+ (org-checkbox-hierarchical-statistics)
+ (org-list-empty-line-terminates-plain-lists)
+ (org-list-description-max-indent): Rename and add aliases to old
+ names.
+
+ * org-element.el (org-element-context): Prevent an error when
+ getting the context of a table rule.
+
+ * org.el (org-deadline-time-hour-regexp)
+ (org-scheduled-time-hour-regexp): New buffer local variables.
+ (org-set-regexps-and-options): Set the new variables.
+
+ * org-agenda.el (org-agenda-custom-commands-local-options): Add
+ :deadline* and :scheduled* to the list of possible agenda entry
+ types.
+ (org-agenda): Implement a new agenda type agenda* with :scheduled*
+ and :deadline* replacing :scheduled and :deadline respectively in
+ agenda entry types. In such agenda, only scheduled and deadline
+ items with a time specification [h]h:mm will be considered.
+ (org-agenda-entry-types): Document the new agenda entry types
+ :scheduled* and :deadline*.
+ (org-agenda-list): New parameter `with-hour'. Use :scheduled* and
+ :deadline*.
+ (org-agenda-get-day-entries): Handle :scheduled* and :deadline*.
+ (org-agenda-get-deadlines, org-agenda-get-scheduled): New
+ parameter `with-hour'. Use `org-deadline-time-hour-regexp' or
+ `org-scheduled-time-hour-regexp' as the search string if needed.
+ (org-agenda-to-appt): Use :scheduled* and :deadline* by default,
+ as other scheduled and deadline items don't have a time spec and
+ cannot be turned into appointments. Trim bracket links and use
+ only the description as the appointment text.
+ (org-agenda-get-restriction-and-command): Add
+ default description for the agenda* view.
+ (org-agenda-run-series): Handle agenda* views.
+
+ * org-faces.el (org-agenda-filter-tags)
+ (org-agenda-diary, org-agenda-calendar-event)
+ (org-agenda-calendar-sexp): Minor code clean up.
+ (org-agenda-filter-category): Docstring fix.
+ (org-agenda-filter-category): New face.
+
+ * org-agenda.el (org-agenda-local-vars): Add
+ `org-agenda-re-filter-overlays' and `org-agenda-regexp-filter'.
+ (org-agenda-mode-map): Use "|" for
+ `org-agenda-filtered-by-regexp'.
+ (org-agenda-re-filter-overlays): New variable.
+ (org-agenda-mark-filtered-text): Use
+ `org-agenda-re-filter-overlays'.
+ (org-agenda-finalize, org-agenda-redo): Allow regexp filtering.
+ (org-agenda-filter-by-category): Set `org-agenda-category-filter'
+ here instead of within `org-agenda-apply-filter'.
+ (org-agenda-regexp-filter): New variable.
+ (org-agenda-filter-by-regexp): New function to filter agenda
+ buffers by regexp.
+ (org-agenda-filter-make-matcher): Make matcher for regexp filters.
+ (org-agenda-filter-apply): Don't set `org-agenda-tag-filter' and
+ `org-agenda-category-filter'. Maybe apply regexp filter.
+ (org-agenda-filter-hide-line): Add docstring. Hide
+ regexp-filtered lines.
+ (org-agenda-filter-show-all-tag, org-agenda-filter-show-all-cat):
+ Add docstring.
+ (org-agenda-filter-show-all-regexp): New function.
+ (org-agenda-set-mode-name): Add regexp-filter information.
+ (org-agenda-custom-commands-local-options): Add regexp filter.
+ (org-agenda-regexp-filter-preset): New variable.
+ (org-agenda-prepare): Use the new variable.
+
+ * ox-odt.el (org-odt-code, org-odt-verbatim): Use
+ `org-odt--encode-plain-text'.
+
+ * ox-html.el (org-html-link): Minor code clean-up.
+
+ * org.el (org-insert-heading): DTRT when in a narrowed region.
+
+ * org-compat.el (org-buffer-narrowed-p): New compatibility
+ function.
+
+ * ox-html.el (org-html-format-inline-image): Fix missing string in
+ formatting string.
+
+ * org-agenda.el (org-agenda-skip-scheduled-if-deadline-is-shown):
+ New allowed value `repeated-after-deadline' which will prevent the
+ display of scheduled items when repeated after the current
+ deadline.
+ (org-agenda-get-scheduled): Handle the new value.
+
+ * org.el (org-time-string-to-absolute): Tiny docstring fix.
+
+ * ox-html.el (org-html-style-default): New classes `footpara' and
+ `footdef' for the footnotes paragraphs and definitions.
+ (org-html-format-footnote-definition): Wrap the footnote
+ defintions into their own div.
+ (org-html-paragraph): Don't add extra <br/> after a paragraph in a
+ footnote.
+ (org-html-container-element, org-html-divs): Mention that
+ org-info.js will not work when changing the defaults.
+
+ * ox-md.el (md): Export underlined text as verbatim.
+
+ * ox-html.el (org-html-style-default): New CSS .underline and
+ #org-div-home-and-up.
+ (org-html-text-markup-alist): Don't hardcode the style, use the
+ new class .underline.
+ (org-html-home/up-format): Don't hardcode the style, use
+ #org-div-home-and-up.
+ (org-html-center-block): Use the .center class.
+
+ * ox-md.el (org-md-underline): New function.
+
+ * org-agenda.el (org-sorting-choice): Fix default value.
+
+ * ox-html.el (org-html-format-footnote-definition)
+ (org-html-footnote-section): Don't wrap footnote definitions into
+ tables.
+ (org-html-paragraph): Add HTML style and class parameter when the
+ paragraph is in a footnote definition. Also allow to add an extra
+ string after the paragraph. Further parameters can be added for
+ paragraphs in other environments.
+ (org-html-template): Always include the title as <h1
+ class="title"></h1>, even when there is no title, as org-info.js
+ needs it.
+
+ * org-element.el (org-element-map): Fix tiny typo in docstring.
+
+ * org-agenda.el (org-agenda-day-view): Fix parameter's name.
+
+ * ox-html.el (org-html-format-inline-image): Don't add superfluous
+ <p></p> when there is an empty caption.
+
+ * org-agenda.el (org-agenda-refile): Enhance docstring. Allow to
+ clear the refile cache with C-0 or C-u C-u C-u.
+
+ * ox-md.el (org-md-export-as-markdown): Tiny docstring fix. Fix a
+ library keyword in the comment section.
+
+ * org.el (org-toggle-item): Convert all normal lines as items when
+ there is a region, and only convert the first line when called
+ with a universal prefix argument. This is consistent with the
+ behavior of `org-toggle-heading'.
+ (org-toggle-heading): When the region contains only normal lines,
+ a universal prefix arg will only convert the first line. This is
+ more consistent with `org-toggle-item'.
+ (orgstruct-setup): Add `org-ctrl-c-minus' and `org-ctrl-c-star'.
+ (customize-package-emacs-version-alist): Update
+ `customize-package-emacs-version-alist'.
+
+ * ox-texinfo.el (org-export-texinfo)
+ (org-texinfo-filename, org-texinfo-classes)
+ (org-texinfo-format-headline-function)
+ (org-texinfo-node-description-column)
+ (org-texinfo-active-timestamp-format)
+ (org-texinfo-link-with-unknown-path-format)
+ (org-texinfo-tables-verbatim)
+ (org-texinfo-table-scientific-notation)
+ (org-texinfo-text-markup-alist)
+ (org-texinfo-format-drawer-function)
+ (org-texinfo-format-inlinetask-function)
+ (org-texinfo-info-process):
+ * ox-odt.el (org-odt-format-drawer-function)
+ (org-odt-format-headline-function)
+ (org-odt-format-inlinetask-function):
+ * ox-md.el (org-export-md, org-md-headline-style): Fix :version
+ and :package-version keywords.
+
+ * org.el (org-time-clocksum-use-effort-durations): Don't set to t
+ by default as it will change many clocktables out there. Let the
+ user decides whether she wants to turn this on.
+
+ * org.el (org-agenda-inhibit-startup): Revert to nil as the default.
+
+ * org-agenda.el (org-agenda-dim-blocked-tasks): Revert to t as the
+ default.
+
+ * ox-html.el (org-html-style-default): More cosmetic tweaks.
+ (org-html-head-include-default-style): Minor docstring update.
+
+ * ox.el (org-export-snippet-translation-alist)
+ (org-export-coding-system, org-export-in-background)
+ (org-export-async-init-file, org-export-invisible-backends)
+ (org-export-dispatch-use-expert-ui):
+ * ox-texinfo.el (org-texinfo-filename, org-texinfo-classes)
+ (org-texinfo-format-headline-function)
+ (org-texinfo-node-description-column)
+ (org-texinfo-active-timestamp-format)
+ (org-texinfo-link-with-unknown-path-format)
+ (org-texinfo-tables-verbatim)
+ (org-texinfo-table-scientific-notation)
+ (org-texinfo-text-markup-alist)
+ (org-texinfo-format-drawer-function)
+ (org-texinfo-format-inlinetask-function)
+ (org-texinfo-info-process):
+ * ox-man.el (org-man-tables-centered)
+ (org-man-table-scientific-notation)
+ (org-man-source-highlight, org-man-source-highlight-langs)
+ (org-man-pdf-process, org-man-logfiles-extensions):
+ * ox-html.el (org-html-allow-name-attribute-in-anchors)
+ (org-html-coding-system, org-html-divs):
+ * ox-ascii.el (org-ascii-text-width)
+ (org-ascii-headline-spacing, org-ascii-indented-line-width)
+ (org-ascii-paragraph-spacing, org-ascii-charset)
+ (org-ascii-underline, org-ascii-bullets)
+ (org-ascii-links-to-notes)
+ (org-ascii-table-keep-all-vertical-lines)
+ (org-ascii-table-widen-columns)
+ (org-ascii-table-use-ascii-art)
+ (org-ascii-format-drawer-function)
+ (org-ascii-format-inlinetask-function):
+ * org.el (org-modules, org-export-backends)
+ (org-highlight-latex-and-related, orgstruct-setup-hook):
+ * org-attach.el (org-attach-git-annex-cutoff):
+ * org-archive.el (org-archive-file-header-format):
+ * org-agenda.el (org-agenda-todo-ignore-time-comparison-use-seconds):
+ * ob-python.el (org-babel-python-hline-to)
+ (org-babel-python-None-to):
+ * ob-ditaa.el (org-ditaa-eps-jar-path):
+ * ob-core.el (org-babel-results-keyword): Add :version and
+ :package-version.
+
+ * ox-ascii.el: Use utf-8-emacs as the file coding system.
+
+ * org-capture.el (org-capture-templates, org-capture-string)
+ (org-capture-steal-local-variables)
+ (org-capture-empty-lines-before)
+ (org-capture-empty-lines-after)
+ (org-capture-insert-template-here)
+ (org-capture-import-remember-templates): Fix or add docstring.
+
+ * ox-html.el (org-html-style-default): Cosmetic changes.
+ (org-html-postamble, org-html-preamble)
+ (org-html-preamble-format): Update docstring.
+
+ * org-agenda.el (org-agenda-format-date-aligned)
+ (org-agenda-time-of-day-to-ampm-maybe)
+ (org-scheduled-past-days)
+ (org-agenda-normalize-custom-commands)
+ (org-agenda-run-series, org-store-agenda-views): Fix or add
+ docstring.
+
+ * ox-latex.el:
+ (org-latex-table-scientific-notation, org-latex-verse-block): Fix
+ typos in docstrings.
+
+ * ox-html.el (org-html-text-markup-alist)
+ (org-html-pretty-output, org-html-link-org-files-as-html)
+ (org-html-postamble, org-html-preamble)
+ (org-html-format-inline-image, org-html-splice-attributes)
+ (org-export-splice-style, org-html-htmlize-region-for-paste)
+ (org-html-fix-class-name)
+ (org-html-format-footnote-reference)
+ (org-html-format-footnotes-section)
+ (org-html-footnote-section, org-html--anchor)
+ (org-html--todo, org-html--tags, org-html-format-headline)
+ (org-html-toc, org-html-format-section, org-html-checkbox)
+ (org-html-format-list-item, org-html-format-latex)
+ (org-html-encode-plain-text)
+ (org-html-table-first-row-data-cells)
+ (org-html-table--table.el-table, org-html-final-function): Fix
+ or add docstring.
+
+ * org.el (org-insert-heading): If the current item has a checkbox,
+ insert the new item with a checkbox.
+
+ * org.el (org-insert-heading): Don't delete spaces in empty
+ headlines.
+
+ * ox-odt.el (org-odt-keyword): Fix typo.
+
+ * ox-latex.el (org-latex-toc-command): Cosmetic docstring change.
+
+ * ox-html.el (org-html-encode-plain-text): Fix typo in docstring.
+
+ * org-faces.el (org-column): Update docstring.
+
+ * org-colview.el: Update error message.
+
+ * org.el (org-modules): Do not include org-mew.el, org-vm.el,
+ org-w3m.el, org-wl.el as these files are now part of contrib/.
+
+ * org-w3m.el:
+ * org-vm.el:
+ * org-w3m.el:
+ * org-wl.el: Delete (moved to Org's contrib/ directory.)
+
+ * org-capture.el (org-mks): Move from org-mks.el.
+
+ * org-mks.el: Delete.
+
+ * ox-html.el (html): Update HTML options names.
+
+ * org.el (org-show-context): Don't try to fix ellipsis when
+ showing a subtree in agenda.
+
+ * ox-html.el (html): Reintroduce #+HTML_HEAD_EXTRA, previously
+ known as HTML_STYLE_EXTRA.
+ (org-html-head): Enhance docstring.
+ (org-html-head-extra): Reintroduce. Was `org-html-style-extra'.
+ (org-html--build-head): Rename from `org-html--build-head'. Add
+ information from `org-html-head-extra'.
+ (org-html-template): Use `org-html--build-head'.
+
+ * ox-html.el (org-html-display-buffer-mode): Delete.
+ (org-html-export-as-html): Use `set-auto-mode' instead of
+ `org-html-display-buffer-mode'.
+
+ * org-agenda.el (org-agenda-write): Overwrite file when called
+ non-interactively.
+
+ * org-mobile.el (org-mobile-edit): Workaround a
+ `org-insert-heading-respect-content' bug which prevents correct
+ insertion when point is invisible
+
+ * org.el (org-previous-line-empty-p): New parameter to allow
+ checking next line. Add a docstring.
+ (org-insert-heading): Handle two universal prefix arguments as
+ advertized in the docstring. Don't insert new lines when
+ creating a heading after the first heading in the current
+ subtree.
+ (org-insert-heading-respect-content): New optional argument
+ arg, passed to `org-insert-heading'.
+
+ * org.el (org-mode): Remove syntax entries. Use
+ `org-backward-element' and `org-forward-element' for
+ `beginning-of-defun-function' and `end-of-defun-function': this
+ allows using C-M-a and C-M-e before the first headline.
+
+ * ox-html.el (html): Remove :html-htmlized-css-url :options-alist.
+
+ * ox-org.el (org-org-htmlized-css-url): Rename from
+ `org-html-htmlized-org-css-url' and moved here from ox-html.el.
+ (org-org-publish-to-org): Handle :htmlized-source in
+ publishing projects.
+
+ * ox-html.el (org-html-style-default): Update docstring.
+ (org-html-infojs-install-script, org-html--build-style): Update
+ property names.
+ (org-html-head-include-scripts)
+ (org-html-head-include-default-style, org-html-head):
+ Respectively rename from `org-html-style-include-scripts',
+ `org-html-style-include-default' and `org-html-style', now
+ obsolete.
+ (org-html-style-extra): Delete.
+
+ * org-clock.el (org-clock-out): Fix bug: if a closing note needs
+ to be stored in the drawer where clocks are stored, let's
+ temporarily remove `org-clock-remove-empty-clock-drawer' from
+ `org-clock-out-hook'.
+
+ * ob-tangle.el (org-babel-tangle): Remove unused attempt of
+ prompting the user of the tangle file name since :tangle is always
+ set. Don't prompt for a tangle file name when called with two
+ universal prefix arg outside of a src block. Use
+ `org-babel-tangle-single-block'.
+ (org-babel-tangle-single-block): New function.
+ (org-babel-tangle-collect-blocks): Use the new function.
+
+ * org-table.el (org-table-convert-region, org-table-export)
+ (org-table-align, org-table-beginning-of-field)
+ (org-table-copy-down, org-table-check-inside-data-field)
+ (org-table-insert-column, org-table-find-dataline)
+ (org-table-delete-column, org-table-move-column)
+ (org-table-insert-row, org-table-insert-hline)
+ (org-table-kill-row, org-table-paste-rectangle)
+ (org-table-wrap-region, org-table-sum, org-table-get-formula)
+ (org-table-get-formula, org-table-get-stored-formulas)
+ (org-table-fix-formulas, org-table-maybe-eval-formula)
+ (org-table-rotate-recalc-marks, org-table-eval-formula)
+ (org-table-get-range, org-table-get-descriptor-line)
+ (org-table-find-row-type, org-table-recalculate)
+ (org-table-iterate, org-table-iterate-buffer-tables)
+ (org-table-formula-handle-first/last-rc)
+ (org-table-edit-formulas, org-table-fedit-shift-reference)
+ (org-rematch-and-replace, org-table-shift-refpart)
+ (org-table-fedit-finish, org-table-fedit-lisp-indent)
+ (org-table-show-reference, org-table-show-reference)
+ (org-table-show-reference, org-table-show-reference)
+ (org-table-force-dataline, orgtbl-error, orgtbl-export)
+ (orgtbl-send-replace-tbl, org-table-to-lisp)
+ (orgtbl-send-table, orgtbl-send-table, orgtbl-send-table)
+ (orgtbl-toggle-comment, orgtbl-insert-radio-table)
+ (orgtbl-to-unicode, org-table-get-remote-range)
+ (org-table-get-remote-range, org-table-copy-dow)
+ (org-table-check-inside-data-field, org-table-insert-colum)
+ (org-table-find-dataline, org-table-delete-colum)
+ (org-table-move-column, org-table-insert-ro)
+ (org-table-insert-hline, org-table-kill-ro)
+ (org-table-paste-rectangle, org-table-wrap-regio)
+ (org-table-sum, org-table-get-formul)
+ (org-table-get-stored-formulas, org-table-fix-formula)
+ (org-table-maybe-eval-formul, org-table-rotate-recalc-marks)
+ (org-table-eval-formul, org-table-get-range)
+ (org-table-get-descriptor-lin, org-table-find-row-type)
+ (org-table-recalculat, org-table-iterate)
+ (org-table-iterate-buffer-table)
+ (org-table-formula-handle-first/last-r)
+ (org-table-edit-formulas, org-table-fedit-shift-referenc)
+ (org-rematch-and-replace, org-table-shift-refpar)
+ (org-table-fedit-finish, org-table-fedit-lisp-inden)
+ (org-table-show-reference, org-table-force-datalin)
+ (orgtbl-error, orgtbl-export, orgtbl-send-replace-tb)
+ (org-table-to-lisp, orgtbl-send-tabl, orgtbl-toggle-comment)
+ (orgtbl-insert-radio-tabl, orgtbl-to-unicode)
+ (org-table-get-remote-range): Use `user-error' instead of
+ `error' for user errors.
+
+ * ob-core.el (org-babel-load-in-session): Throw a useful error
+ when there is no code block at point.
+
+ * ob-tangle.el (org-babel-tangle): Rename the ONLY-THIS-BLOCK
+ parameter to ARG. Allow two universal prefix arguments to tangle
+ by the target file of the block at point.
+ (org-babel-tangle-collect-blocks): New parameter TANGLE-FILE
+ to restrict the collection of blocks to those who will be
+ tangled in TARGET-FILE.
+
+ * org-src.el (org-edit-src-auto-save-idle-delay): Use a delay of 0
+ by default (i.e., deactivate auto-saving.)
+ (org-edit-src-code): Set `buffer-auto-save-file-name' for
+ auto-saving with `auto-save-mode'.
+
+ * org.el (org-deadline, org-schedule): When called with two
+ universal prefix arguments, set the warning time or the delay
+ relatively to the current timestamp, not to today's date.
+
+ * org-agenda.el (org-agenda-filter-apply): Deactive
+ `org-agenda-entry-text-mode' when filtering.
+ (org-agenda-entry-text-mode): Don't allow in filtered views.
+ Don't show the maximum number of lines when turning off.
+
+ * ox-html.el (org-html-headline): Add comment.
+
+ * org.el (org-mode): Set `paragraph-start'.
+
+ * org-agenda.el (org-agenda-entry-text-leaders): New option.
+ (org-agenda-entry-text-show-here): Use it.
+
+ * ox-html.el (org-html-link--inline-image): Always retrieve
+ attributes for inline images.
+ (org-html-link): Fix trailing whitespace at the end of the opening
+ <a ...> HTML tag.
+ (org-html-headline): For headlines whose first element is a
+ headline and not a section, pretend there is an empty section (as
+ "") for the correct HTML div to be inserted.
+
+ * org-agenda.el (org-agenda-collect-markers)
+ (org-create-marker-find-array): Move to ox-icalendar.el.
+ (org-agenda-marker-table, org-check-agenda-marker-table):
+ Delete.
+
+ * ox-icalendar.el (org-icalendar-create-uid): New parameter
+ H-MARKERS to only update some headlines, not the whole file.
+ (org-icalendar--combine-files): When exporting to an .ics file
+ only add UID to the headlines shown in the agenda buffer.
+ (org-agenda-collect-markers, org-create-marker-find-array):
+ Move here.
+
+ * org-agenda.el (org-agenda-write): Ask before overwriting an
+ existing file.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option/infojs_opt):
+ Use `org-html-infojs-opts-table'.
+
+ * ox-html.el (org-html-infojs-opts-table):
+ (org-html-use-infojs, org-html-infojs-options)
+ (org-html-infojs-template): Move from ox-jsinfo.el. Rename using
+ the org-html- prefix.
+ (org-html-infojs-install-script): Move from ox-infojs.el.
+
+ * ox-infojs.el: Delete.
+
+ * ox-html.el (org-html-section): Fix indentation.
+ (org-html-inner-template): Add the document title here, within the
+ "content" class, as the org-info.js needs it.
+ (org-html-template): Don't include the document's title here.
+ (org-html-format-inlinetask-function): Remove wrong example.
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks): Don't collect
+ blocks in commented out headings.
+
+ * ox-latex.el (org-latex-logfiles-extensions)
+ (org-latex-remove-logfiles): Improve docstrings.
+
+ * org-capture.el (org-capture): Cosmetic fix.
+
+ * org-protocol.el (org-protocol-create-for-org)
+ (org-protocol-create): Small docstrings enhancements.
+
+ * org-protocol.el (org-protocol-capture): Small docstring fix.
+
+ * org.el (org-speed-command-activate): Only forbid in src code
+ blocks.
+
+ * org-indent.el
+ (org-indent-add-properties): Bugfix: prevent negative value for
+ `added-ind-per-lvl'.
+
+ * org.el (org-mode): Add `org-fix-ellipsis-at-bol' to
+ `isearch-mode-end-hook' so that any isearch fixes the problem with
+ ellipsis on the first line.
+ (org-fix-ellipsis-at-bol): New defsubst.
+ (org-show-context, org-isearch-end): Use it.
+
+ * org-agenda.el (org-agenda-deadline-leaders): New formatting
+ string for past deadlines.
+ (org-agenda-scheduled-leaders): Small change.
+ (org-agenda-get-deadlines): Use the new formatting string.
+
+ * ob-lob.el (org-babel-lob-execute): Rename cache? to cache-p.
+
+ * org.el (org-speed-command-activate): Don't activate speed
+ commands within blocks.
+
+ * org.el (org-show-context): Remove useless catch. Make sure the
+ top of the window is a visible headline.
+ (org-activate-plain-links): Remove unused catch.
+
+ * org-macs.el (org-get-alist-option): Return nil, not (nil), so
+ that `org-show-context' DTRT.
+
+ * org.el (org-imenu-get-tree): Fix bug when matching against empty
+ headlines.
+ (org-overview): Stay on current line.
+ (org-map-entries): Fix docstring.
+
+ * org-macs.el (org-unmodified): Update comment. Don't define
+ `with-silent-modifications' for emacsen that don't have it.
+
+ * org-compat.el (org-with-silent-modifications): New
+ compatibility macro.
+
+ * org.el (org-refresh-category-properties)
+ (org-refresh-properties, org-entry-blocked-p)
+ (org-agenda-prepare-buffers):
+
+ * org-indent.el (org-indent-remove-properties)
+ (org-indent-add-properties):
+
+ * org-colview.el (org-columns-display-here)
+ (org-columns-remove-overlays, org-columns-quit)
+ (org-columns-edit-value, org-columns-compute-all)
+ (org-columns-compute, org-agenda-colview-compute):
+
+ * org-clock.el (org-clock-sum): Use the compatibility macro
+ `org-with-silent-modifications' instead of
+ `with-silent-modifications'.
+
+ * org.el (org-sort-remove-invisible): Remove emphasis markers.
+
+ * org.el (org-sort-remove-invisible): Use defsust. Do not only
+ check against invisible links, truly returns the visible part of
+ the string.
+ (org-sort-remove-invisible): Add a docstring.
+ (org-sort-entries): Remove hidden links when comparing entries.
+
+ * org-list.el (org-sort-list): Remove hidden links when comparing
+ list items.
+
+ * ox-html.el (org-html-headline): Fix typo.
+ (org-html-format-headline--wrap): Cosmetic change.
+
+ * org.el (org-at-clock-log-p): Delete.
+
+ * org-clock.el (org-at-clock-log-p): Move here.
+
+ * ox-html.el (org-html-format-headline-function): Fix docstring.
+
+ * ob-sql.el (org-babel-execute:sql): Add header row delimiter for
+ both mysql and postgresql.
+
+ * org.el (org-agenda-prepare-buffers): Don't use
+ `with-silent-modifications' too early.
+
+ * org-macs.el: Add a comment on when to use `org-unmodified' and
+ when to use `with-silent-modifications'.
+
+ * org-colview.el (org-columns-display-here)
+ (org-columns-remove-overlays, org-columns-quit)
+ (org-columns-edit-value, org-columns-compute-all)
+ (org-columns-compute, org-agenda-colview-compute):
+ * org-clock.el (org-clock-sum):
+ * org.el (org-refresh-category-properties)
+ (org-refresh-properties, org-entry-blocked-p)
+ (org-agenda-prepare-buffers): Use `with-silent-modifications'
+ instead of `org-unmodified'.
+
+ * ox-publish.el (org-publish-sitemap-date-format): Small docstring
+ enhancement.
+
+ * ox-latex.el (org-latex-format-headline-default-function): New
+ option.
+ (org-latex-format-headline-function): Use the new option as
+ the default value.
+ (org-latex-toc-command): Don't add vertical space after the table
+ of contents.
+
+ * org.el (org-entry-blocked-p): Use `org-unmodified' instead of
+ `org-with-buffer-modified-unmodified'.
+ (org-agenda-prepare-buffers): Fix indentation.
+
+ * org-macs.el (org-unmodified): Rename from
+ `org-with-buffer-modified-unmodified'.
+ (org-with-buffer-modified-unmodified): Delete.
+
+ * ob-python.el (org-babel-python-command): Use a defcustom.
+ (org-babel-python-mode): Use a defcustom and default to
+ 'python-mode when featured.
+
+ * org-agenda.el (org-agenda-start-day): Refer to `org-read-date'
+ in the docstring.
+
+ * ox-org.el (org-org-publish-to-org): Autoload.
+
+ * org-protocol.el:
+ * org-bibtex.el: Remove remember support.
+
+ * org-clock.el (org-clock-heading-for-remember): Delete.
+ (org-clock-in): Do not set the heading for remember.
+
+ * org.el (org-move-subtree-down, org-forward-element)
+ (org-backward-element):
+
+ * org-table.el (org-table-previous-field)
+ (org-table-move-column, org-table-move-row):
+
+ * org-list.el (org-move-item-down, org-move-item-up)
+ (org-cycle-item-indentation): Use `user-error' when moving or
+ modifying the element at point is not possible.
+
+ * ox-html.el (org-html-table-header-tags)
+ (org-html-table-data-tags, org-html-table-row-tags)
+ (org-html-table-align-individual-fields): Use the
+ org-export-html group.
+ (org-html-inline-src-block, org-html-link): Fix error messages.
+ (org-html-begin-plain-list): Fix formatting, better FIXME
+ comment.
+
+ * org.el (org-fill-paragraph): Fill using
+ `org-mode-transpose-word-syntax-table'.
+
+ * ox-org.el (org-org-publish-to-org): New defun.
+
+ * ox-html.el (org-export-htmlize): Delete group.
+ (org-html-htmlize-output-type)
+ (org-html-htmlized-org-css-url)
+ (org-html-htmlize-region-for-paste): Rename from
+ org-export-htmlize-*.
+ (org-html-htmlize-generate-css, org-html-fontify-code): Use
+ the correct names.
+
+ * org-compat.el (org-file-equal-p): New compatibility function.
+
+ * ox.el (org-export-output-file-name): Use the new function.
+
+ * org-clock.el (org-clock-set-current)
+ (org-clock-delete-current): Delete.
+ (org-clock-in, org-clock-out): Set and delete
+ `org-clock-current-task'. Minor code clean-up.
+
+ * org-clock.el (org-clock-in, org-clock-in-last): Tell
+ `org-current-time' to always return a past time.
+
+ * org.el (org-current-time): New argument `past' to force
+ returning a past time when rounding.
+
+ * org-agenda.el (org-agenda-unmark-clocking-task): New function.
+ (org-agenda-mark-clocking-task): Use it.
+ (org-agenda-clock-in): Let the cursor where it is.
+ (org-agenda-clock-out): Ditto. Also remove the
+ `org-agenda-clocking' overlay.
+
+ * org-agenda.el (org-agenda-set-restriction-lock): Fix restriction
+ so that it ends at the beginning of the next headline at the same
+ level.
+
+ * org.el (org-set-effort, org-property-next-allowed-value):
+ When needed, update the current clock effort time.
+ (org-next-link): New parameter `search-backward'. Fix bug when at
+ a link with no 'org-link face, e.g., in a DONE headline. Throw a
+ message instead of an error.
+ (org-previous-link): Use `org-next-link'.
+
+ * org-agenda.el (org-agenda-format-item): Only set the breadcrumbs
+ when `org-prefix-has-breadcrumbs' is non-nil.
+
+ * org.el (org-mode): Don't make characters from
+ `org-emphasis-alist' word constituants.
+ (org-mode-transpose-word-syntax-table): Rename from
+ `org-syntax-table'.
+ (org-transpose-words): Use
+ `org-mode-transpose-word-syntax-table'.
+
+ * ox.el (org-export--dispatch-ui)
+ (org-export--dispatch-action): Use integers for control chars.
+
+ * org-agenda.el (org-agenda-set-restriction-lock): Put the
+ overlay until the end of the subtree, not the end of the
+ headline.
+
+ * org.el (org-entry-delete, org-delete-property): New optional
+ arg delete-empty-drawer, a string, to delete any empty drawer
+ with that name.
+ (org-toggle-ordered-property): Delete the drawer "PROPERTIES"
+ if empty.
+
+ * org-src.el (org-src-mode-map, org-edit-src-code)
+ (org-edit-fixed-width-region, org-edit-src-save): Use C-c C-k
+ for `org-edit-src-abort'.
+
+ * org.el (org-mode): Use org-unmodified during startup
+ initialization for functions that may be inhibited.
+
+ * org-table.el (org-table-align): Only set the window start
+ when table alignment is performed in the selected window.
+
+ * org-src.el (org-edit-src-auto-save-idle-delay): New option.
+ (org-src-ask-before-returning-to-edit-buffer): Make a defcustom.
+ (org-edit-src-code-timer): New timer variable.
+ (org-edit-src-code): Run the timer.
+ (org-edit-fixed-width-region): Enhance message.
+ (org-edit-src-exit): Cancel the timer.
+ (org-edit-src-save): Prevent saving when editing fixed-width
+ buffer, exiting will save already.
+ (org-edit-src-exit): Inconditionally kill the src/example
+ editing buffer.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option): Require
+ 'org-element. This fixes a bug about unbound variable
+ `org-element-affiliated-keywords' when trying to complete a
+ keyword before 'org-element was required.
+
+ * org-list.el (org-list-bullet-string): Replace match when there
+ is a match, otherwise just return the bullet.
+
+ * org-src.el (org-src-mode-map): New binding C-c k to abort
+ editing.
+ (org-edit-src-code): Mention the keybinding to abort editing
+ and go back to the correct position.
+ (org-edit-src-abort): New command to abort editing.
+
+ * ox-html.el (org-html--build-meta-info): Add a newline before
+ the title meta information.
+
+ * org.el (org-return-follows-link): Mention that this does not
+ affect the behavior of RET in tables.
+
+ * ox-html.el (org-html--build-mathjax-config): Only include
+ MathJax configuration if the resulting HTML contains LaTeX
+ fragments.
+
+ * org.el (org-syntax-table, org-transpose-words): Delete.
+ (org-mode): Syntactically Define {} and <> as parentheses.
+ (org-drag-line-forward, org-drag-line-backward): New
+ functions.
+ (org-shiftmetaup, org-shiftmetadown): Fall back on the new
+ functions instead of throwing an error.
+ (org-make-org-heading-search-string): Don't use statistic or [x/y]
+ cookies when creating a link.
+
+ * ox-html.el (org-html-table): Append #+attr_html attributes.
+
+ * org.el (org-emphasis-alist, org-protecting-blocks):
+ * org-src.el (org-edit-src-find-region-and-lang):
+ * org-list.el (org-list-forbidden-blocks):
+ * org-footnote.el (org-footnote-forbidden-blocks): Remove
+ references to the deleted DocBook exporter.
+
+ * org.el (org-end-of-line): Don't throw an error outside elements.
+
+ * ox-html.el (org-html-link): Don't throw an error if the value
+ of the :ID: property has not been generated by uuidgen.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option/x):
+ Resurrect. Use `org-default-options' to initialize completion
+ fonctions for the most important keywords.
+
+ * org-macs.el (org-default-options): Rename and adapt from
+ `org-get-current-options'.
+
+ * org.el (org-options-keywords): Add keywords.
+
+ * ox-odt.el (org-odt-convert-read-params): Fix typo in prompt.
+
+ * ox-latex.el (org-latex-horizontal-rule): Fix typo in docstring.
+
+ * ox-html.el (org-html-display-buffer-mode): New option.
+ (org-html-export-as-html): Use it.
+
+ * ob-core.el (org-babel-insert-result): Fix bug when inserting
+ an empty string as the result.
+
+ * org.el (org-timestamp-change): New optional parameter
+ `suppress-tmp-delay' to suppress temporary delay like "--2d".
+ (org-auto-repeat-maybe): Suppress temporary delays.
+
+ * org-agenda.el (org-agenda-get-scheduled): When the delay is
+ of the form "--2d" and there is a repeater, ignore the delay
+ for further repeated occurrences.
+
+ * org-agenda.el (org-agenda-get-deadlines)
+ (org-agenda-get-scheduled): Minor refactoring.
+
+ * org.el (org-time-string-to-absolute): Tiny docstring enhancement.
+ (org-edit-special): Don't allow to edit when buffer is read only.
+
+ * ox-html.el (org-html-format-latex): Don't set `cache-relpath'
+ and `cache-dir' when `processing-type' is 'mathjax.
+ (org-html-format-latex): Fix conversion in non-file buffers.
+
+ * org.el (org-speed-commands-default): Bind `B' and `F' to
+ `org-previous-block' and `org-next-block'.
+ (org-read-date-minibuffer-local-map): Use "!" instead of "?" to
+ see today's diary as "?" is already bounded by Calendar.
+ (org-read-date-minibuffer-local-map): Use "." to go to today's
+ date.
+
+ * ob-core.el (org-babel-next-src-block)
+ (org-babel-previous-src-block): Rewrite using
+ `org-next-block'.
+
+ * org.el (org-next-block, org-previous-block): New navigation
+ commands.
+ (org-mode-map): Bind the new commands to C-c C-F and C-c C-B
+ respectively.
+
+ * org-agenda.el (org-agenda-write): Don't copy headlines' subtrees
+ when writing to an .org file.
+
+ * org.el (org-copy-subtree): New parameter `nosubtrees'.
+
+ * org-agenda.el (org-agenda-write): Allow writing to an .org file.
+
+ * org.el (org-paste-subtree): Fix typo in docstring.
+
+ * org-agenda.el (org-agenda-get-todos)
+ (org-agenda-get-timestamps): Use nil as `ts-date' for diary
+ sexpressions.
+ (org-agenda-get-todos): Skip diary sexps when trying to sort by
+ timestamp.
+ (org-agenda-max-entries, org-agenda-max-todos)
+ (org-agenda-max-tags, org-agenda-max-effort): New options.
+ (org-timeline, org-agenda-list, org-search-view)
+ (org-todo-list, org-tags-view): Tell `org-agenda-finalize-entries'
+ what agenda type we are currently finalizing for.
+ (org-agenda-finalize-entries): Limit the number of entries
+ depending on the new options.
+ (org-agenda-limit-entries): New function.
+
+ * org.el (org-deadline): Allow a double universal prefix argument
+ to insert/update a warning cookie.
+ (org-deadline): Allow a double universal prefix argument to
+ insert/update a delay cookie.
+
+ * org-agenda.el (org-agenda-skip-scheduled-delay-if-deadline):
+ New option. The structure of the possible values is copied
+ from `org-agenda-skip-deadline-prewarning-if-scheduled'.
+ (org-agenda-get-scheduled): Honor the two new option,
+ `org-scheduled-delay-days' and
+ `org-agenda-skip-deadline-prewarning-if-scheduled'. I.e. if a
+ scheduled entry has a delay cookie like "-2d" (similar to the
+ prewarning cookie for deadline), don't show the entry until
+ needed.
+
+ * org.el (org-deadline-warning-days): Small docstring fix.
+ (org-scheduled-delay-days): New option (see
+ `org-deadline-warning-days'.)
+ (org-get-wdays): Use the new option.
+
+ * org-agenda.el (org-agenda-sorting-strategy): Document the
+ new sorting strategies.
+ (org-agenda-get-todos, org-agenda-get-timestamps)
+ (org-agenda-get-deadlines, org-agenda-get-scheduled): Add a
+ `ts-date' text property with scheduled, deadline or timetamp
+ date.
+ (org-cmp-ts): New function to compare timestamps.
+ (org-em): Add a docstring.
+ (org-entries-lessp): Use `org-cmp-ts' to compare timestamps.
+ Implement the following sorting strategies: timestamp-up/down,
+ scheduled-up/down, deadline-up/down, ts-up/down (for active
+ timestamps) and tsia-up/down (for inactive timestamps.)
+
+ * ob-lilypond.el (ly-process-basic): Bugfix, don't use `pcase'.
+
+ * org.el (org-contextualize-validate-key): Check against two new
+ context predicates [not-]in-buffer.
+
+ * org-agenda.el (org-agenda-custom-commands-contexts):
+ Document the new [not-]in-buffer context predicates.
+
+ * ob-core.el (org-ts-regexp): Remove duplicate defconst'ing.
+ (org-babel-result-regexp): Don't use `org-ts-regexp', use a regexp
+ string directly.
+
+ * ob-lilypond.el (ly-process-basic): Don't use `ly-gen-png' and
+ friends, rely on the extension of the output file.
+
+ * org-archive.el (org-archive-file-header-format): New option.
+ (org-archive-subtree): Use it.
+
+ * ob-lilypond.el (ly-process-basic): Rely on ly-gen-png/pdf/eps to
+ set the output type.
+
+ * org.el (org-read-date-minibuffer-local-map): New variable.
+ (org-read-date): Use it.
+ (org-read-date-minibuffer-setup-hook): Mark as obsolete.
+ (org-read-date): Bind `!' to `diary-view-entries' in order to
+ check diary entries while setting an Org date.
+
+ * org-agenda.el (org-diary): Only keep the descriptions of the
+ links since Org links are not active in the diary buffer.
+
+ * org-faces.el (org-priority): New face.
+
+ * org.el (org-font-lock-add-priority-faces): Use the new face.
+
+ * org-agenda.el (org-agenda-fontify-priorities): Use the
+ org-priority face and add specific agenda face on top of it.
+
+ * org-agenda.el (org-agenda-show-clocking-issues)
+ (org-agenda-format-item): Let-bind
+ `org-time-clocksum-use-effort-durations' to nil.
+
+ * org.el (org-ctrl-c-ctrl-c): Only throw a message when using two
+ universal prefix arguments on a list where all items are already
+ in a transitory state. Refine the error when the checkbox cannot
+ be toggled.
+
+ * org.el ("org-loaddefs.el"): Load org-loaddefs.el before
+ requiring any org library. Also use `load', not
+ `org-load-noerror-mustsuffix'.
+ (org-effort-durations): Move up to fix a compiler warning.
+ (org-edit-special): Fix typo in docstring.
+ (org-time-clocksum-format): Add a version tag and add to the
+ 'org-clock group.
+ (org-time-clocksum-use-fractional): Ditto.
+ (org-time-clocksum-use-effort-durations): New option to allow
+ using `org-effort-durations' when computing clocksum durations.
+ (org-minutes-to-clocksum-string): Use the new option.
+
+ * org-clock.el (org-clocktable-write-default): Let-bind
+ `org-time-clocksum-use-effort-durations' to a new clocktable
+ parameter ":effort-durations".
+
+ * org-entities.el (org-entities): "neg" should be used in LaTeX
+ math mode. Add the "neg" entity.
+
+ * org-mobile.el (org-mobile-allpriorities): New option.
+ (org-mobile-create-index-file): Use the new option.
+
+ * org-latex.el (org-export-latex-inline-images): New option.
+
+ * org.el (org-forward-heading-same-level): Before the first
+ headline, go to the first headline.
+ (org-backward-heading-same-level): Before the first headline,
+ go to the beginning of the buffer, like
+ `outline-previous-visible-heading' does.
+
+ * org-exp.el (org-export-plist-vars): Don't use
+ `org-export-html-inline-images' to set the :inline-images
+ property, use distinct properties for the various backends.
+
+ * org-publish.el (org-publish-project-alist): Ditto.
+
+ * org-latex.el (org-export-latex-links): Use :latex-inline-images
+ instead of :inline-images.
+
+ * org-odt.el (org-compat): Require.
+
+ * org.el (org-parse-time-string): Allow strings supported by
+ tags/properties matcher (eg <now>, <yesterday>, <-7d>).
+
+ * org-clock.el (org-clock-rounding-minutes): New option to round
+ the time by N minutes in the past when clocking in or out.
+ (org-clock-in, org-clock-in-last, org-clock-out): Use the new
+ option.
+
+ * org.el (org-current-time): New optional parameter
+ `rounding-minutes' to override the use of
+ `org-time-stamp-rounding-minutes' for rounding.
+
+ * org-clock.el (org-clock-special-range): Small docstring fix.
+ New parameter 'weekstart to define the week start day.
+ (org-clock-special-range, org-dblock-write:clocktable)
+ (org-dblock-write:clocktable, org-clocktable-write-default)
+ (org-clocktable-steps, org-clock-get-table-data): Use the new
+ parameter.
+ (org-clocktable-defaults): Set monday as the starting day of the
+ week by setting :wstart to 1.
+
+ * org.el (org-store-link): Fix the naming of internal links to
+ lines starting with a keyword.
+
+ * org-agenda.el (org-agenda-Quit, org-agenda-quit)
+ (org-agenda-exit, org-agenda-kill-all-agenda-buffers):
+ Docstring fixes.
+
+ * org.el (org-last-set-property-value): New variable.
+ (org-read-property-name): Fix dangling parentheses.
+ (org-set-property-and-value): New command to manually set
+ both the property and the value. A prefix arg will use the
+ last property-value pair set without prompting the user.
+ (org-set-property): Set `org-last-set-property-value'.
+ (org-mode-map): Bind the new command to `C-c C-x P'.
+ (org-find-invisible-foreground): Delete.
+ (org-mode): Use `face-background' instead of
+ `org-find-invisible-foreground'.
+ (org-startup-options): New startup keywords.
+ (org-log-into-drawer): Update docstring to explain how to set this
+ variable through the startup keyword "logdrawer" and "nologdrawer".
+ (org-log-states-order-reversed): Document the new startup keywords
+ "logstatesreversed" and "nologstatesreversed".
+ (org-mode-map): Use `org-remap' instead of binding `M-t' to
+ `org-transpose-words' directly.
+ (org-syntax-table): New variable.
+ (org-transpose-words): New command, simply wrapping the new
+ syntax table around `transpose-words'.
+ (org-mode-map): Bind `org-transpose-words' to `M-t'.
+ (org-store-link): Use keyword at point as the search string. Use
+ `delq nil' instead of `delete nil'.
+ (org-make-org-heading-search-string): Rewrite using
+ org-element.el. Not an interactive function anymore.
+
+ * org-pcomplete.el (pcomplete/org-mode/drawer): Ditto.
+
+ * org-mobile.el (org-mobile-files-alist): Ditto.
+
+ * org.el (org-store-link): When creating a link to a heading with
+ a bracket link, don't escape this link with curly braces as the
+ escaped link is not active anyway; use the description instead.
+ If the headline only consists of a bracket link, add a star to the
+ description so that the user knows this is an internal link.
+
+ * org-w3m.el (org-w3m-store-link): New function.
+
+ * org.el (org-store-link): Update the error message when no method
+ is available for storing a link. Use `user-error' for this.
+ Remove handling w3m links from this function.
+ (org-insert-heading, org-insert-todo-heading): A double prefix arg
+ force the insertion of the subtree at the end of the parent
+ subtree.
+ (org-store-link): A double prefix argument now skips module
+ store-link functions to only use Org's core functions. Also, when
+ several modular store-link functions match, ask for which one to
+ use.
+ (org-cycle, org-cycle-internal-global)
+ (org-cycle-internal-local, org-display-outline-path): Let-bind
+ `message-log-max' to nil so that messages don't populate the
+ *Messages* buffer.
+
+ * org-table.el (org-table-eval-formula): Handle localized
+ time-stamps by internally converting them to english during
+ formulas evaluation.
+
+ * org.el (org-clock-timestamps-up): Fix declarations.
+
+ * ob-core.el (org-split-string): Declare function.
+
+ * org-html.el (org-html-export-list-line): Add CSS classes to
+ these list HTML tags: <ul> <dl> and <ol>.
+
+ * org-clock.el (org-clock-timestamps-up)
+ (org-clock-timestamps-down, org-clock-timestamps-change): Add
+ an optional argument N to change timestamps by several units.
+
+ * org.el (org-shiftcontrolup, org-shiftcontroldown): Ditto.
+
+ * org-exp.el (org-export-copy-to-kill-ring): Add a new choice
+ 'if-interactive and use it as the default.
+ (org-export-push-to-kill-ring): Use the new choice.
+
+ * org.el (org-block-entry-blocking): New variable.
+ (org-todo): Use it. Also use `user-error' when a TODO state
+ change is blocked.
+ (org-block-todo-from-children-or-siblings-or-parent): Display
+ `org-block-entry-blocking' in the user-error message.
+
+ * org.el (org-get-cursor-date): New optional argument WITH-TIME to
+ add the time of the day.
+
+ * org-capture.el (org-capture): When capturing from the agenda and
+ with a non-nil value for `org-capture-use-agenda-date', a `C-1'
+ prefix will set the capture time to the HH:MM of the current line
+ or the current HH:MM.
+
+ * org-agenda.el (org-agenda-capture): New optional argument
+ WITH-TIME: when set to 1, the capture time will be set to the
+ HH:MM time of the current line, or the current HH:MM time.
+
+ * org.el (org-latex-preview-ltxpng-directory): Fix docstring
+ formatting.
+ (org-deadline-close): Use `org-time-stamp-to-now'.
+ (org-time-stamp-to-now): Use `org-float-time' instead of the
+ obsolete `time-to-seconds' function.
+ (org-format-outline-path): Fix bug: add the separator string after
+ the prefix.
+ (org-display-inline-images): Search for #+ATTR within the current
+ paragraph.
+ (org-days-to-time): Make obsolete.
+ (org-time-stamp-to-now): Rename from `org-days-to-time'.
+ Allow to compare time-stamps based on seconds.
+
+ * org-agenda.el (org-agenda-todo-ignore-time-comparison-use-seconds):
+ New option to compare time stamps using seconds, not days.
+ (org-agenda-todo-custom-ignore-p)
+ (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item):
+ Use the new function's name and the new option.
+
+ * org-clock.el (org-clock-sound): Enhance docstring.
+ (org-notify): Use the parameter `play-sound' as argument for
+ `org-clock-play-sound'.
+ (org-clock-play-sound): New optional argument `clock-sound' to
+ override `org-clock-sound'.
+
+ * org-agenda.el (org-agenda-format-item): Fix initialization
+ of the level text property.
+
+ * org.el (org-format-outline-path): Small docstring
+ enhancement.
+ (org-display-outline-path): Fix order or arguments.
+
+ * org.el (org-activate-plain-links)
+ (org-activate-bracket-links): Add a new 'htmlize-link text
+ property, so that htmlize (> version 1.42) can linkify the
+ links.
+ (org-display-outline-path): Allow a string value for the
+ `as-string' parameter. Such a value will replace the "/"
+ separator in the output. New argument `as-string'.
+ (org-refile-keep): New variable.
+ (org-copy): New command to copy notes.
+ (org-refile): New parameter msg to override the "Refile" string in
+ the default prompt.
+ (org-mode-map): Bind "C-c M-w" to `org-copy'.
+ (org-refile-get-location): Use the current file name as the
+ default target when there is no refile history.
+ (org-cycle-hide-inline-tasks): New function to hide inline tasks
+ when cycling.
+ (org-cycle-hook): Use the new function.
+ (org-entry-put): Fix bug when updating the last clock.
+ (org-use-last-clock-out-time-as-effective-time): New option.
+ (org-current-effective-time): Use the new option.
+
+ * org-clock.el (org-clock-get-last-clock-out-time): New
+ function.
+
+ * org.el (org-toggle-inline-images): Only send a message when
+ called interactively.
+ (org-scan-tags): Fix the declaration and the use of
+ `org-agenda-format-item'.
+
+ * org-agenda.el (org-agenda-add-time-grid-maybe): Use the
+ correct number of parameters for `org-agenda-format-item'.
+ Add a docstring.
+
+ * org.el (org-outline-level): Go at the beginning of the
+ headline first to always return a sensible result.
+
+ * org-agenda.el (org-search-view, org-agenda-get-todos)
+ (org-agenda-get-timestamps, org-agenda-get-sexps)
+ (org-agenda-get-progress, org-agenda-get-deadlines)
+ (org-agenda-get-scheduled, org-agenda-get-blocks): Return the
+ correct level depending on `org-odd-levels-only'.
+ (org-agenda-prefix-format): A new specifier `%l' allows to insert
+ X spaces when the item is of level X.
+ (org-search-view, org-get-entries-from-diary)
+ (org-agenda-get-todos, org-agenda-get-timestamps)
+ (org-agenda-get-sexps, org-agenda-get-progress)
+ (org-agenda-get-deadlines, org-agenda-get-scheduled)
+ (org-agenda-get-blocks, org-agenda-change-all-lines): Add a
+ new text property 'level, a string with as many whitespaces as
+ the level of the item.
+ (org-agenda-format-item, org-compile-prefix-format): Handle
+ the new `%l' specifier.
+
+ * org-colview.el (org-columns-next-allowed-value): Add the
+ CLOCKSUM property to the list of properties that can be
+ changed interactively from the column view.
+
+ * org.el (org-entry-put): Allow to set the CLOCKSUM property
+ by updating the most recent clock. This is useful in the
+ column view when you want to use S-<left/right> to update the
+ last clock of the entry at point.
+ (org-image-actual-width): New choice: use #+ATTR* or fall back on
+ a number.
+ (org-display-inline-images): Implement the new choice.
+ (org-image-actual-width): Rename from `org-image-fixed-width'.
+ Update the docstring. Give more choice.
+ (org-display-inline-images): Use the option new choices.
+ (org-image-fixed-width): New option to set a fixed width for
+ inline images.
+ (org-display-inline-images): Use the new option.
+
+ * org-agenda.el (org-class): Allow to use holiday strings for
+ the `skip-weeks' arguments.
+
+ * org.el (org-mode): Set the syntax of the " character to "string
+ quote".
+
+ * org-agenda.el (org-agenda-append-agenda): Bugfix: correctly
+ check whether we are in `org-agenda-mode'.
+ (org-agenda): Set `org-agenda-buffer-name' correctly with sticky
+ agendas and non-custom commands.
+
+2013-11-12 Bill Day <[email protected]> (tiny change)
+
+ * org-taskjuggler.el
+ (org-export-taskjuggler-valid-task-attributes): Add chargeset and
+ charge.
+
+2013-11-12 Carsten Dominik <[email protected]>
+
+ * org-src.el (org-edit-src-exit): Let overlay survive after the
+ buffer has been saved.
+
+ * ox-texinfo.el (org-texinfo-export-to-texinfo): Use new style
+ backquoting.
+ (org-texinfo-export-to-info): Use new style backquoting.
+
+ * ob-latex.el (org-babel-execute:latex): Call `file-name-sans-extension'
+ instead of `file-base-name'.
+
+ * org.el (org-insert-heading): Improve whitespace behavior at
+ end of subtree.
+ (org-latex-default-packages-alist): Add the `rotating' package to
+ the list of default packages. Improve docstring.
+ (org-insert-property-drawer): Insert only after space in current
+ line.
+ (org-forward-paragraph, org-backward-paragraph): Do not deactivate
+ the mark.
+ (org-special-ctrl-o): New option.
+ (org-open-line): Don't do anything special unless `org-special-ctrl-o'
+ is non-nil.
+
+ * org-agenda.el (org-agenda-custom-commands-local-options):
+ (org-agenda-span, org-agenda-ndays-to-span)
+ (org-agenda-span-to-ndays, org-agenda-list, org-agenda-later)
+ (org-agenda-change-time-span, org-agenda-compute-starting-span): Add
+ support for fortnight view.
+ (org-agenda-menu): Add fortnight view command.
+ (org-agenda-fortnight-view): New command.
+
+ * org-timer.el (org-clock-sound): Silence compiler.
+
+ * org.el (org-beginning-of-line, org-end-of-line): Bind
+ deactivate-mark to avoid that this command deactivates it.
+ (org-make-tags-matcher): Do not interpret / in property value as
+ starter of TODO match.
+ (org-overview): Preserve point.
+ (org-read-date-minibuffer-local-map): Don't replace disputed keys
+ when defining this keymap.
+ (org-read-date): Remove unnecessary binding of
+ `org-replace-disputed-keys'.
+ (org-insert-heading): Allow to remove blank lines if the user does
+ not want any.
+ (org-unlogged-message): Fix typo in dostring.
+
+ * ob-ruby.el: New customizations `org-babel-ruby-hline-to' and
+ `org-babel-ruby-nil-to'
+ (org-babel-ruby-var-to-ruby): Convert incoming 'hlines.
+ (org-babel-ruby-table-or-string): Convert outgoing nils.
+
+ * org.el (org-file-apps-defaults-gnu): Use `xdg-open' to open
+ files where available.
+
+ * org-table.el (orgtbl-radio-table-templates): Improve docstring.
+
+ * org.el (org-unlogged-message): New function.
+ (org-cycle, org-cycle-internal-global, org-cycle-internal-local)
+ (org-global-cycle, org-display-outline-path): Use
+ `org-unlogged-message'.
+
+ * org-pcomplete.el (org-make-org-heading-search-string): Fix
+ function declaration.
+ (pcomplete/org-mode/searchhead): Remove incorrect second arguments
+ to `org-make-org-heading-search-string'.
+
+ * org.el (org-read-date): Turn off replacing disputed keys when
+ defining the minibuffer keys during date selection.
+ (org-insert-heading): Improve the empty line insertion behavior.
+ Basically, never remove empty lines, only add them.
+
+ * org-attach.el (org-attach-commit): Use vc-git to find the git
+ repository.
+
+ * org-compat.el (org-move-to-column): Turn off invisibility stuff
+ for moving the cursor to a column.
+
+ * org.el (org-modules): Update with the new module org-mac-link.
+ (org-display-outline-path): Do not log outline path in Message
+ buffer.
+ (org-agenda-ignore-drawer-properties): New option.
+ (org-agenda-prepare-buffers): Honour
+ `org-agenda-ignore-drawer-properties'.
+
+ * org-clock.el (org-clock-goto): Recenter to thrd line
+
+ * org-table.el (orgtbl-send-replace-tbl): Allow multiple spaces
+ between keywords in RECEIVE ORGTBL lines.
+
+ * org.el (org-bookmark-names-plist): New user option.
+ (org-set-regexps-and-options-for-tags): Use `org-bookmark-names-plist'.
+ (org-refile): Use `org-bookmark-names-plist'.
+
+ * org-capture.el (org-capture-bookmark-last-stored-position): Use
+ `org-bookmark-names-plist'.
+
+ * org.el (org-insert-heading): Rewritten from scratch.
+ (org-N-empty-lines-before-current): New function
+ (org-insert-heading-respect-content): Set the correct argument to
+ force a heading even in lists.
+
+ * org-colview.el (org-columns-display-here): Enforce fixed width
+ font.
+
+ * org-faces.el (org-column): Setting font width has been shifted
+ to org-colview.el.
+
+ * org.el (org-mode-flyspell-verify): Check for src block.
+
+ * org-table.el (org-table-convert-region): Fix interactive
+ statement.
+
+ * org-ctags.el (org-ctags-path-to-ctags): Avoid usine `case'.
+
+ * org.el (org-beginning-of-line,org-end-of-line): Set
+ disable-point-adjustment when the command ends next to invisible
+ text.
+
+ * ob-lob.el (org-babel-lob-files): Fix custom type.
+
+ * org-agenda.el (org-agenda-export-html-style, org-agenda-ndays)
+ (org-agenda-inactive-leader, org-agenda-day-face-function)
+ (org-agenda-auto-exclude-function): Fix custom type.
+
+ * org-bibtex.el (org-bibtex-prefix): Fix custom type.
+
+ * org-clock.el (org-clock-heading-function):
+ (org-show-notification-handler): Fix custom type.
+
+ * org-footnote.el (org-footnote-auto-adjust): Fix custom type.
+
+ * org-protocol.el (org-protocol-default-template-key): Fix custom
+ type.
+
+ * org.el (org-make-link-description-function):
+ (org-link-translation-function):
+ (org-link-frame-setup):
+ (org-refile-target-verify-function):
+ (org-get-priority-function):
+ (org-use-fast-tag-selection):
+ (org-columns-modify-value-for-display-function):
+ (org-sparse-tree-default-date-type):
+ * ox-html.el (org-html-postamble):
+ (org-html-postamble-format):
+ (org-html-preamble-format):
+ * ox-odt.el (org-odt-content-template-file):
+ * ox.el (org-export-with-archived-trees):
+ (org-export-initial-scope): Fix custom type.
+
+ * org.el (org-insert-heading): Fix problem with inserting heading.
+ Check for checkbox at the beginning of the item, not just at the
+ beginning of the line.
+ (org-small-year-to-year): Fix docstring typo.
+ (org-show-siblings): By default, also show siblings from a
+ bookmark jump.
+
+ * org-agenda.el (org-agenda-set-restriction-lock): Highlight only
+ the headline when agenda is restricted to a subtree. Do not
+ highlight the entire subtree.
+
+ * org-table.el (org-table-eval-formula): Work-around for calc-eval
+ regression.
+
+ * ox.el (org-export-dispatch): Make sure the last position marker
+ uses the base buffer if there is one.
+ (org-export-dispatch-last-position): New variable.
+ (org-export-dispatch): Save position of cursor at the moment when
+ the export command is called. Restore that position temporarily
+ when repeating the previous export command.
+
+ * org.el (org-insert-heading): Shrink whitespace at end of subtree
+ when `org-insert-heading-respect-content' is on.
+
+ * org-list.el (org-sort-list): Respect sorting-type and
+ getkey-func when they are specified in the call.
+
+ * org.el (org-sort-entries): Respect sorting-type and getkey-func
+ when they are specified in the call.
+ (org-format-outline-path): New argument SEPARATOR to specify a
+ string that is inserted between parts of the outline path.
+ (org-display-outline-path): New argument SEPARATOR, to specify a
+ string that is inserted between parts of the outline path.
+
+ * org-colview.el (org-dblock-write:columnview): Change the capture
+ of pos to after inserting the original content
+
+2013-11-12 Christian Moe <[email protected]>
+
+ * ox-odt.el (org-odt-line-break, org-odt-plain-text): Remove
+ newline after line-break tag.
+
+2013-11-12 Christophe Junke <[email protected]> (tiny change)
+
+ * org.el (org-set-font-lock-defaults): Let footnote fontifications
+ be done before other links' fontification. This allows links
+ appearing inside footnotes to be both visible and active.
+
+2013-11-12 Christopher Schmidt <[email protected]>
+
+ * org.el (orgstruct-setup): Major rewrite.
+ (orgstruct++-mode): Overwrite local non-org vars again.
+ (orgstruct-mode): Simplify implementation. Emulate outline's
+ buffer-invisiblity-spec.
+ (orgstruct-heading-prefix-regexp): Change default value to nil.
+ (orgstruct-error): Use `user-error' if available.
+ {pro,de}motion commands if `orgstruct-heading-prefix-regexp' is
+ non-nil. Always use `org-outline-level'. Bind org-shift*.
+ (orgstruct-make-binding): Major rewrite.
+ (org-cycle-global-status, org-cycle-subtree-status): Set state
+ property.
+ (org-heading-components): Use `org-heading-regexp' in
+ orgstruct-mode.
+ (orgstruct-heading-prefix-regexp, orgstruct-setup-hook): New
+ options.
+ (orgstruct-initialized): New variable.
+ (org-get-local-variables): Honour state property.
+ (org-run-like-in-org-mode): Use `let' instead of `progv'. Do not
+ override variables with non-default values.
+ (org-forward-heading-same-level): Do not skip to headlines on
+ another level. Handle negative prefix argument correctly.
+ (org-backward-heading-same-level): Use
+ `org-forward-heading-same-level'.
+
+2013-11-12 Craig Tanis <[email protected]> (tiny change)
+
+ * ox-latex (org-latex-src-block): Change format string to position
+ caption after figure content.
+
+2013-11-12 Eric Abrahamsen <[email protected]>
+
+ * org.el (org-ctrl-c-ctrl-c): `C-c C-c' on a link is usually a
+ no-op. If that link is in a headline, act as if the `C-c C-c' was
+ called on the headline, not the link.
+
+ * ox-html.el (org-html-doctype-alist): New variable holding an
+ alist of (X)HTML doctypes
+ (org-html-xhtml-p, org-html-html5-p, org-html-close-tag): New
+ function.
+ (org-html-html5-fancy): New export option, determining whether or
+ not to use HTML5-specific elements.
+ (org-html-html5-elements): New variable, new HTML5 elements.
+ (org-html-special-block): Export special blocks to new HTML5
+ elements.
+ (org-html-format-inline-image): Use <figure> and <figcaption> for
+ standalone images.
+ (org-html-format-inline-image, org-html--build-meta-info)
+ (org-html--build-head, org-html--build-pre/postable)
+ (org-html-template, org-html-horizontal-rule)
+ (org-html-format-list-item, org-html-line-break, org-html-table)
+ (org-html-verse-block): Changes to allow flavored export.
+
+ * ox-latex.el (org-latex--org-table, org-latex-table-row): Allow
+ use of the "tabu" and "longtabu" table environments. New table
+ attribute :spread handles the width specification syntax of "tabu"
+ and "longtabu" table environments.
+
+2013-11-12 Eric Schulte <[email protected]>
+
+ * org-bibtex.el (org-bibtex-read-buffer): Reads all bibtex entries
+ in a buffer.
+ (org-bibtex-read-file): Read all bibtex entries in a file.
+ (org-bibtex-import-from-file): Import all bibtex entries from a
+ file into the current buffer.
+
+ * ob-tangle.el (org-babel-load-file): When called with a prefix
+ argument the tangled emacs-lisp file will be byte compiled.
+
+ * ob-tangle.el (org-babel-tangle): Tangled files should not be
+ writable.
+
+ * ob-emacs-lisp.el (org-babel-execute:emacs-lisp): Better about
+ when to fully escape the results or just print them close to
+ verbatim.
+
+ * ob.el (org-babel-result-cond): This function should now be used
+ by all language backends to handle the processing of raw code
+ block output into scalar results, table results, or ignored
+ results depending on the value of result-params.
+
+ * ob-C.el (org-babel-C-execute): Use org-babel-result-cond.
+
+ * ob-R.el (org-babel-R-evaluate-external-process)
+ (org-babel-R-evaluate-session):
+ * ob-awk.el (org-babel-execute:awk):
+ * ob-clojure.el (org-babel-execute:clojure):
+ * ob-emacs-lisp.el (org-babel-execute:emacs-lisp):
+ * ob-fortran.el (org-babel-execute:fortran):
+ * ob-io.el (org-babel-io-evaluate):
+ * ob-java.el (org-babel-execute:java):
+ * ob-lisp.el (org-babel-execute:lisp):
+ * ob-maxima.el (org-babel-execute:maxima):
+ * ob-picolisp.el (org-babel-execute:picolisp):
+ * ob-python.el (org-babel-python-evaluate-external-process):
+ (org-babel-python-evaluate-session):
+ * ob-scala.el (org-babel-scala-evaluate):
+ * ob-sh.el (org-babel-sh-evaluate):
+ * ob-shen.el (org-babel-execute:shen):
+ * ob-sql.el (org-babel-execute:sql):
+ * ob-sqlite.el (org-babel-execute:sqlite): Use
+ `org-babel-result-cond'.
+
+ * ob.el (org-babel-common-header-args-w-values): Add a new "none"
+ header argument.
+ (org-babel-execute-src-block): Don't do *any* result processing if
+ the "none" header argument has been specified.
+ (org-babel-sha1-hash): Remove the none header argument from header
+ arg lists when calculating cache sums.
+ (org-babel-insert-result): Flesh out some documentation.
+
+ * ob.el (org-babel-insert-result): Don't escape results in
+ drawers.
+
+ * ob-python.el (org-babel-python-hline-to): Customize hline
+ conversion to python.
+ (org-babel-python-None-to): Customize none conversion from python.
+ (org-babel-python-var-to-python): Use new variable.
+ (org-babel-python-table-or-string): Use new variable.
+
+ * org.el (org-babel-load-languages): Add ob-makefile to
+ `org-babel-load-languages'.
+
+ * ob-makefile.el: New file.
+
+ * ob-sh.el (org-babel-sh-evaluate): Don't could 0-length shebangs.
+
+ * org.el (org-format-latex): Simplify and now make use of the new
+ `org-create-formula-image' function.
+ (org-create-formula-image): Provides a simpler interface to the
+ two backend-specific functions.
+
+ * ob-core.el (org-babel-default-header-args): It is likely that
+ someone meant to set :padlines to "yes", but accidentally set
+ :padnewlines to "yes". Either way lets just remove this which
+ shouldn't have any functional effect.
+
+ * ob-haskell.el (org-babel-default-header-args:haskell): Set
+ :padlines to "no" by default.
+
+ * ob-exp.el (org-babel-exp-non-block-elements): Ignore inline
+ source block on #+ prefixed lines.
+
+ * ob-core.el (org-babel-merge-params): Replace `remove-if' with
+ `org-remove-if'. More careful to check that the colname- and
+ rowname-names header arguments exist during merge. When merging
+ parameters, if a variable is replaced with a new value, then
+ delete colnames/rownames for the original value of that variable.
+
+ * ob-ditaa.el (org-babel-ditaa-java-cmd): Make java executable
+ configurable for ditaa blocks.
+
+ * ob-sh.el (org-babel-sh-var-to-string): Fix bug in ob-sh when
+ dealing with list variables.
+
+ * ob-core.el (org-babel-demarcate-block): Include
+ `org-src-lang-modes' in block demarcation options.
+
+ * ob-C.el: Don't modify `org-babel-load-languages' from ob-*
+ files.
+
+ * ob-latex.el (org-babel-latex-htlatex): Set this variable to
+ "htlatex" (or path to said) to enable svg generation from latex
+ code blocks.
+ (org-babel-latex-htlatex-packages): Libraries required for
+ automatic svg generation.
+ (org-babel-execute:latex): Generate SVG images directly from latex
+ code blocks (assumes tikz).
+
+ * ob-exp.el (org-babel-exp-non-block-elements): Use lob call name
+ when exporting.
+
+ * ob-scheme.el (org-babel-scheme-get-repl)
+ (org-babel-scheme-make-session-name)
+ (org-babel-scheme-execute-with-geiser, org-babel-execute:scheme):
+ Fix whitespace and indentation.
+
+ * ob-core.el (org-babel-set-current-result-hash): Update the
+ match-string holding the hash data, and correct overlay
+ maintenance.
+ (org-babel-find-named-result): Call lines are not results.
+ (org-babel-where-is-src-block-result): Don't implicitly name the
+ results of call lines.
+ (org-babel-exp-non-block-elements): There is now another element
+ on the call line info list.
+
+ * ob-lob.el (org-babel-lob-get-info): Return the name (if any) at
+ the end of the info list.
+ (org-babel-lob-execute): Pass the name through to execution.
+
+ * ob-core.el (org-babel-execute-src-block): Ensure that the
+ location is set before anything else is done.
+
+ * ob-ref.el (org-babel-ref-parse): Evaluate Emacs Lisp values in
+ header arguments at the location of the original code block.
+
+ * ob-gnuplot.el (org-babel-expand-body:gnuplot): Use new header
+ arguments.
+
+ * ob-core.el (org-babel-common-header-args-w-values): Mention new
+ header arguments.
+ (org-babel-expand-body:generic): Use new header arguments.
+ (org-babel-read-result): More robust matching of examplized
+ ranges.
+ (org-babel-result-end): More robust matching of examplized ranges.
+
+ * ob-gnuplot.el (org-babel-expand-body:gnuplot): Gnuplot, close
+ output terminal when opened.
+ (org-babel-gnuplot-prefix): Customization variable prefix gnuplot
+ code blocks.
+ (org-babel-expand-body:gnuplot): Customization variable prefix
+ gnuplot code blocks.
+
+ * ob-core.el (org-babel-params-from-properties): Now returns a
+ list of alists and does *not* call `org-babel-merge-params'.
+ (org-babel-parse-src-block-match):
+ (org-babel-parse-inline-src-block-match):
+ * ob-exp.el (org-babel-exp-src-block):
+ (org-babel-exp-non-block-elements):
+ * ob-lob.el (org-babel-lob-execute): Handle new list of lists
+ output of `org-babel-params-from-properties'.
+
+ * ob-gnuplot.el (org-babel-header-args:gnuplot): Term is a gnuplot
+ header argument.
+
+ * ob-tangle.el (org-babel-tangle): Fixed bug in tangle-file.
+ Collect tangle modes, and only apply them to the file after all
+ tangling has completed, including the post-tangle-hook.
+
+ * ob-core.el (org-babel-read): Do not read #-prefix header-arg
+ value as emacs lisp.
+
+ * ob-core.el (org-babel-current-src-block-location):
+ (org-babel-execute-src-block):
+ * ob-exp.el (org-babel-exp-results):
+ * ob-lob.el (org-babel-lob-execute): Rename
+ `org-babel-current-exec-src-block-head' to
+ `org-babel-current-src-block-location'.
+
+ * ob-core.el (org-babel-common-header-args-w-values): Adding the
+ new :tangle-mode header argument.
+ (org-babel-read): Read values starting with a "#" character as
+ emacs lisp.
+
+ * ob-tangle.el (org-babel-tangle): Use the new :tangle-mode header
+ argument.
+
+ * org-pcomplete.el (pcomplete/org-mode/block-option/src): Use the
+ new :tangle-mode header argument.
+
+ * ob-exp.el (org-babel-exp-results): Save the code block location
+ into `org-babel-current-exec-src-block-head' during export.
+
+ * ob-comint.el (org-babel-comint-with-output): More robust edebug
+ spec.
+
+ * ob-lob.el (org-babel-lob-execute): Set the
+ `org-babel-current-exec-src-block-head' variable when executing
+ inline or lob style code.
+
+ * ob-core.el (org-babel-execute-src-block): The
+ `org-babel-current-exec-src-block-head' variable should point to
+ the outermost code block.
+
+ * org.el (org-some): An org-mode version of the cl some function.
+
+ * ob-fortran.el (org-babel-fortran-var-to-fortran): More careful
+ check if values are matrices.
+
+ * org.el (org-every): An Org-mode version of the cl every
+ function.
+
+ * ob-tangle.el (org-babel-tangle-jump-to-org): Use
+ `org-src-switch-to-buffer' to jump from src to org. Use the
+ existing `org-edit-src' functionality to jump back to the correct
+ point in the code block in the original Org-mode buffer.
+
+ * ob-gnuplot.el (org-babel-gnuplot-quote-tsv-field): Only wrap
+ gnuplot data values in " when necessary. Replace missing values
+ with blank space in gnuplot.
+ (org-babel-expand-body:gnuplot):
+ (org-babel-gnuplot-quote-timestamp-field): Fix indentation.
+ (org-babel-header-args:gnuplot): Declare the.
+ (org-babel-expand-body:gnuplot): Params is an alist not a plist.
+ (org-babel-header-args:gnuplot): Declare gnuplot-specific header
+ argument.
+ (*org-babel-gnuplot-missing*): Dynamic variable used to hold the
+ value of the missing header argument.
+ (org-babel-gnuplot-process-vars): Wrap in local binding for
+ missing value.
+ (org-babel-gnuplot-quote-tsv-field): Replace missing value with
+ the missing header argument value when present.
+
+ * ob-org.el (org-babel-expand-body:org): Allow insertion of
+ non-strings into Org code blocks.
+ (org-babel-inline-result-wrap): New option controlling the
+ wrapping of inline results.
+ (org-babel-examplize-region): Use the new defcustom.
+
+ * ox-beamer.el (org-beamer--format-frame): If contents is nil,
+ then replace it with an empty string.
+
+ * ob-core.el (org-babel-read): More restrictive elisp eval of
+ header arguments.
+
+ * ob-lob.el (org-babel-lob-execute): Include default elisp header
+ args in call lines.
+
+ * ob-core.el (org-babel-result-cond): Don't over-evaluate
+ result-params in macro.
+
+ * ob-ruby.el (org-babel-execute:ruby): Use `org-babel-result-cond'
+ in Ruby code blocks.
+ (org-babel-ruby-evaluate): Delay table processing.
+
+ * ob-js.el (org-babel-execute:js): Use `org-babel-result-cond' in
+ JavaScript code blocks.
+
+ * ob-scheme.el (org-babel-execute:scheme): Use
+ `org-babel-result-cond' in scheme code blocks.
+
+ * ob-ocaml.el (org-babel-execute:ocaml): Use
+ `org-babel-result-cond' in OCaml code blocks.
+
+ * ob-haskell.el (org-babel-execute:haskell): Use
+ `org-babel-result-cond' in Haskell code blocks.
+
+ * ob-core.el (org-babel-result-cond): The "raw", "org" and
+ "drawer" :results header argument values preclude table processing
+ unless the "table" argument is given as well.
+ (org-babel-execute-src-block): Make sure we process file results
+ before they are passed to the post-processing code block, and not
+ afterwards. Tangles these two header arguments in the code, but
+ makes for more intuitive behavior and enables important use cases.
+ (org-babel-read): Read code block values with earmuffs as Emacs
+ Lisp.
+ (org-babel-common-header-args-w-values): Add :post to the list of
+ header arguments.
+ (org-babel-execute-src-block): Post process results when the :post
+ header argument has been supplied.
+
+ * ob-R.el (org-babel-R-initiate-session): Remove unnecessary
+ save-excursion nested inside a save-window-excursion.
+
+ * ob-core.el (org-babel-src-name-w-name-regexp): Update the regexp
+ used to match code block names.
+ (org-babel-get-src-block-info): Remove the code used to parse this
+ alternate variable specification syntax.
+ (org-babel-insert-result): Cycle tables for :results org and
+ :results wrap.
+
+ * ob-python.el (org-babel-python-initiate-session-by-key): Fixed a
+ bug pointed out by Gary Oberbrunner.
+ (org-babel-python-initiate-session-by-key): Add "-i" to the python
+ command on windows sessions. Actually setting new session names.
+ Pass Python buffer names to the new `run-python' command.
+ (org-babel-python-with-earmufs): Add earmufs to a buffer name.
+ (org-babel-python-without-earmufs): Remove earmufs from a buffer name.
+ (org-babel-python-initiate-session-by-key): Set the buffer name in
+ a way which is understandable by the new python.el
+ (org-babel-python-buffers): Change the default python buffer name.
+
+ * ob-core.el (org-babel-number-p): Don't interpret single "-" as a
+ number.
+
+ * ob-perl.el (org-babel-perl--var-to-perl): Print Perl variables
+ with a format string.
+
+ * ob-core.el (org-babel-where-is-src-block-result): Allow comments
+ between code blocks and un-named results.
+
+ * ob-sqlite.el (org-babel-sqlite-table-or-scalar): Don't read
+ sqlite output as lisp.
+
+ * ob-core.el (org-babel-check-confirm-evaluate): Refactoring.
+ (org-babel-confirm-evaluate): Fix whitespaces.
+ (org-babel-execute-src-block): A cond makes it more clear that we
+ definitely do not execute without user confirmation.
+ (org-babel-call-process-region-original): Fixed line over 80 chars
+ long.
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks): Update comment
+ to reflect changed variable name.
+
+ * ob-core.el (org-babel-expand-src-block): Return value of
+ expanded code block on non-interactive calls.
+
+ * ob-perl.el (org-babel-perl-var-wrap): Customizable wrapper for
+ variables in perl code.
+ (org-babel-perl-var-to-perl): Use said wrapper.
+
+ * ob-sql.el (org-babel-execute:sql): Use the org-babel-eval
+ command instead of shell-command.
+
+ * ob-ocaml.el (org-babel-prep-session:ocaml): Check that
+ `tuareg-run-caml' is defined before use.
+ (tuareg-run-ocaml): Declare for compiler.
+
+ * ob-core.el (org-babel-result-regexp): Simplify regexp given new
+ time hash layout.
+ (org-babel-current-result-hash): New match string.
+ (org-babel-hide-hash): New match string.
+ (org-babel-where-is-src-block-result): New match string, and
+ insert hashes in the new format.
+
+ * ob-core.el (org-ts-regexp): Declare.
+ (org-babel-result-regexp): Now matching time stamp as well.
+ (org-babel-hash-show-time): New variable controlling the display
+ of time stamps.
+ (org-babel-current-result-hash):
+ (org-babel-hide-all-hashes):
+ (org-babel-where-is-src-block-result): Use hash time stamps.
+
+ * ob-core.el: New file.
+
+ * org-macs.el: `org-load-noerror-mustsuffix' requires an autoload.
+
+2013-11-12 Feng Shu <[email protected]>
+
+ * ox-odt.el (org-odt--translate-latex-fragments):
+ * ox-html.el (org-html-latex-environment)
+ (org-html-latex-fragment): Fix imagemagick support.
+
+ * org.el (org-create-formula-image-with-imagemagick): Generate
+ correct size formula image.
+ (org-format-latex-header): Change pagestyle command position.
+
+ * ox-latex.el (org-latex--caption/label-string): Allow to build a
+ caption string from `:caption' attribute of #+ATTR_LATEX.
+
+ * ox.el (org-export-dictionary): Add Simplified Chinese
+ translations for `org-export-dictionary'.
+
+2013-11-12 Florian Beck <[email protected]> (tiny change)
+
+ * org.el (org-activate-bracket-links): Remove escapes from the
+ help string.
+
+2013-11-12 Francesco Pizzolante <[email protected]> (tiny change)
+
+ * ox-html.el (org-html-headline): Normalize the construction of
+ outline-container DIVs by always using the inner headline ID.
+
+ * org.el (org-agenda-prepare-buffers): Protect with
+ `org-unmodified'.
+
+2013-11-12 Gregor Kappler <gregor@alcedo.(none)> (tiny change)
+
+ * ox.el (org-export-as): Make sure org-export-babel-evaluate is
+ not nil before calling `org-export-execute-babel-code'.
+
+2013-11-12 Grégoire Jadi <[email protected]>
+
+ * org.el (org-reftex-citation): Fix contrib package name in the
+ docstring.
+ (org-preview-latex-fragment, org-display-inline-images): Detect
+ whether a graphic display is available before inlining images to
+ prevent an error.
+ (org-startup-with-latex-preview): New option.
+ (org-startup-options): New startup keywords for the new option.
+ (org-mode): Turn on/off LaTeX preview depending on the new option.
+ (org-reverse-string): Add `org-reverse-string' to reverse a
+ string.
+
+ * org-id.el (org-id-new, org-id-decode): Replace
+ `org-id-reverse-string' by `org-reverse-string'.
+
+ * ob-core.el (org-babel-trim): Replace `org-babel-reverse-string'
+ by `org-reverse-string' and declare it.
+
+2013-11-12 Gustav Wikström <[email protected]> (tiny change)
+
+ * org-agenda.el (org-agenda-filter-by-category): Display all
+ filtered out categories.
+
+2013-11-12 Ilya Zonov <[email protected]> (tiny change)
+
+ * org-mode (org-mouse-context-menu): Add a correct newtext
+ parameter for "All Set" and "All Clear" menu items.
+
+2013-11-12 Ingo Lohmar <[email protected]> (tiny change)
+
+ * org.el (org-insert-todo-heading-respect-content): Pass correct
+ prefix arg to always insert heading.
+
+ * org-agenda.el
+ (org-agenda-propertize-selected-todo-keywords): New function to
+ highlight the current agenda todo keywords depending on
+ `org-todo-keyword-faces'.
+ (org-todo-list): Use the new function.
+
+2013-11-12 Ippei FURUHASHI <[email protected]>
+
+ * org-table.el (org-calc-current-TBLFM): New function to
+ re-calculate the table by applying the #+TBLFM in the line where
+ the point is. Ensure to remove the currently inserted TBLFM line,
+ when calling `org-table-recalculate' returns an error and the
+ processing stops.
+
+ * org.el (org-ctrl-c-ctrl-c): Call `org-calc-current-TBLFM' when
+ point is in the #+TBLFM line.
+
+ * org-table.el (org-TBLFM-begin): New function.
+ (org-TBLFM-begin-regexp): New variable.
+
+ * org.el (org-at-TBLFM-p): New function.
+ (org-TBLFM-regexp): New defconst.
+
+2013-11-12 Ivan Vilata i Balaguer <[email protected]> (tiny change)
+
+ * org-clock.el (org-clock-get-table-data): Pass tstart and tend
+ time strings through `org-matcher-time' to allow relative times
+ besides absolute ones, convert result to encoded time.
+
+2013-11-12 Jambunathan K <[email protected]>
+
+ * ox-html.el (org-html-code, org-html-verbatim): Transcode value.
+ (org-html--tags, org-html-format-headline)
+ (org-html--format-toc-headline, org-html-checkbox)
+ (org-html-table-cell, org-html-timestamp)
+ (org-html-verse-block, org-html-special-string-regexps): Replace
+ named HTML entities with their numeric counterparts. This keeps
+ Freemind backend happy.
+
+ * org-odt.el (org-export-odt-schema-dir): Modify to accommodate
+ change in rnc file names.
+
+ * org-lparse.el (org-lparse-and-open)
+ (org-lparse-do-convert): Open exported files with system-specific
+ application.
+
+ * org-odt.el: Don't meddle with `org-file-apps'.
+
+2013-11-12 Jarmo Hurri <[email protected]>
+
+ * org-table.el (org-define-lookup-function): New macro. Call it
+ to generate new lookup functions `org-lookup-first',
+ `org-lookup-last' and `org-lookup-all'.
+
+ * org-gnus.el (org-gnus-no-server): New option to start Gnus using
+ `gnus-no-server'.
+ (org-gnus-no-new-news): Use the new option.
+
+2013-11-12 Jonas Hoersch <[email protected]> (tiny change)
+
+ * org.el (org-cycle-hide-inline-tasks): Re-hide inline tasks when
+ switching to 'children visibility state.
+
+ * org-inlinetask.el (org-inlinetask-toggle-visibility): Don't use
+ `org-show-entry' as it cannot unfold an inlinetask properly.
+
+2013-11-12 Jonathan Leech-Pepin <[email protected]>
+
+ * ox-texinfo.el: New file.
+
+2013-11-12 Joost Diepenmaat <[email protected]> (tiny change)
+
+ * org.el (org-indent-region): BEGIN_SRC and END_SRC lines should
+ not be considered part of the source block for the purposes of
+ indentation.
+
+2013-11-12 Justus Piater <[email protected]>
+
+ * org-agenda.el
+ (org-agenda-skip-deadline-prewarning-if-scheduled): Add an option
+ to skip the deadline prewarning if the scheduled date is in the
+ future.
+
+2013-11-12 Kodi Arfer <[email protected]> (tiny change)
+
+ * ox-html.el (org-html-toc): Use <nav> instead of <div> for the
+ root element when appropriate.
+ (org-html-paragraph): Wrap "Figure %d:" in <span
+ class="figure-number">.
+ (org-html-list-of-tables, org-html-table): Wrap "Table %d:" in
+ <span class="table-number">.
+ (org-html-list-of-listings): Wrap "Listing %d:" in
+ <span class="listing-number">.
+ (org-html-table): For HTML5, omit :html-table-attributes but not
+ :id or :attr_html.
+ (org-html--build-meta-info): Insert no timestamp when
+ :time-stamp-file is nil.
+
+2013-11-12 Lawrence Mitchell <[email protected]>
+
+ * ox-html.el (org-html-close-tag): Add space before attr.
+
+ * ox.el (org-export-resolve-fuzzy-link): Look for fuzzy link in a
+ cache before trying to resolve it in the parse tree.
+
+2013-11-12 Le Wang <[email protected]>
+
+ * org-src.el (org-edit-src-code): Use marker with insertion type t
+ to track end and remove hack requiring delete from beg to (1-
+ end).
+
+2013-11-12 Max Mikhanosha <[email protected]>
+
+ * org-habit.el (org-habit-get-faces): Add show done days green
+ option.
+
+ * org-agenda.el (org-agenda-format-item): Ensure effort is "" when
+ unset
+
+2013-11-12 Michael Brand <[email protected]>
+
+ * org-table.el (org-table-eval-formula): Align the arrow pointing
+ to the error in a Calc formula to the other fomula debugger logs.
+
+ * org.el (org-link-escape-chars-browser): Add char double quote.
+ (org-open-at-point): Use the constant
+ `org-link-escape-chars-browser'.
+
+ * org-table.el (org-table-get-remote-range): Extend regexp to
+ match "#+NAME: table" additionally to "#+TBLNAME: table".
+
+ * org-table.el (org-table-eval-formula): Use `keep-empty' in more
+ places. Keep empty fields during preprocessing.
+ (org-table-make-reference): Use nan (not a number) for empty
+ fields in Calc formulas. A range with only empty fields should
+ not always return 0 but also empty string, consistent with field
+ reference of an empty field. Use future design for nan but
+ replicate current behavior.
+ (org-table-number-regexp): Extend 0x hex to fixed-point number,
+ add <radix>#<number>, add Calc infinite numbers uinf, -inf and
+ inf.
+
+2013-11-12 Michael Gauland <[email protected]>
+
+ * ob-ebnf.el: New file.
+
+2013-11-12 Muchenxuan Tong <[email protected]> (tiny change)
+
+ * org-mobile.el (org-mobile-push): Add `save-restriction'.
+
+2013-11-12 Nicolas Goaziou <[email protected]>
+
+ * ox-latex.el (org-latex-compile): Remove all numbered temporary
+ files after compiling.
+
+ * org-element.el (org-element-headline-interpreter): Take into
+ consideration `org-odd-levels-only' when building a headline.
+
+ * ox-org.el (org-org-headline): Correctly set transcoded headline
+ level during subtree export.
+
+ * ox-html.el (org-html--format-toc-headline): TOC entries are
+ closer to regular headline formatting.
+
+ * org-element.el (org-element-context): Fix error when parsing
+ affiliated keywords, e.g. "caption".
+
+ * org.el (org-do-emphasis-faces): Look for verbatim status at
+ correct location.
+ (org-open-at-point): Check if link is non-nil before matching it.
+ (org-export-insert-default-template): Make sure strings are
+ properly quoted when inserting a template. Specifically, default
+ value for drawers should be d:(not "LOGBOOK"), not d:(not
+ LOGBOOK).
+ (org-insert-heading): Do not error out when inserting is to be
+ done at one of the buffer's boundaries.
+
+ * ox-latex.el (org-latex-listings-options): Use correct number of
+ backslash characters in the example.
+
+ * org-element.el (org-element-latex-or-entity-successor)
+ (org-element-latex-fragment-parser): Use `org-latex-regexps'
+ instead of `org-format-latex-options'.
+
+ * ox-ascii.el:
+ * ox-beamer.el:
+ * ox-html.el:
+ * ox-icalendar.el:
+ * ox-md.el: Remove comments at the beginning of the file since
+ the library is documented in Org manual.
+
+ * org-element.el (org-element--list-struct): Use
+ `org-match-string-no-properties'. Fix block parsing in lists.
+
+ * ox-publish.el (org-publish-all): Fix compilation problem.
+
+ * org-element.el (org-element-timestamp-interpreter): Correctly
+ interpret timestamps with delays.
+ (org-element-timestamp-parser)
+ (org-element-timestamp-interpreter): Parse warning delays.
+
+ * ox-beamer.el (org-beamer--format-section): Fix regression which
+ prevents frames from being propely exported.
+
+ * ox.el (org-export-with-backend): Ensure function will use
+ provided back-end.
+
+ * org-list.el (org-list-allow-alphabetical): Remove reference to
+ unused VALUE.
+
+ * ox-beamer.el (org-beamer--format-section): Protect fragile
+ commands in sections.
+
+ * org.el (org-ctrl-c-ctrl-c): When using C-c C-c at an item with
+ point on a link, make sure checkbox, if any, is toggled.
+
+ * ox-beamer.el (org-beamer--format-block): Return an error message
+ when using a special environment as a block type. Also check for
+ incomplete environment definitions.
+
+ * org-element.el (org-element-at-point): If point is at the end of
+ the buffer, and that buffer ends with a list, and there's no final
+ newline, return last element in last item instead of plain list.
+ Fix infloop when called on a blank line at the end of the buffer
+ after a headline.
+
+ * org.el (org-forward-paragraph, org-backward-paragraph): New
+ functions.
+
+ * org.el (org-meta-return): Allow M-RET to insert items within
+ drawers. Rewrite function.
+
+ * org-element.el (org-element-footnote-definition-parser): Fix
+ value for :contents-begin when first line of footnote definition
+ is empty besides the label.
+ (org-element-at-point): Return correct element when point is on a
+ blank line just below a headline.
+ (org-element-paragraph-parser): Use
+ `org-match-string-no-properties'. Small fixes to paragraph
+ parsing.
+
+ * org.el (org-adaptive-fill-function): Do not handle
+ `adaptive-fill-regexp' in comments as the behaviour is not
+ satisfying.
+
+ * org-list.el (org-list-struct-apply-struct): Do not move item's
+ contents within a child above when repairing indentation.
+
+ * ox-html.el (org-html--build-meta-info): Fix output of meta tags
+ when properties are present.
+
+ * ox.el (org-export-collect-headlines): Do not build TOC for
+ headlines below H value.
+
+ * org-element.el (org-element-context): Modify misleading
+ comment.
+ (org-element-text-markup-successor)
+ (org-element-latex-or-entity-successor)
+ (org-element-export-snippet-successor)
+ (org-element-footnote-reference-successor)
+ (org-element-inline-babel-call-successor)
+ (org-element-inline-src-block-successor)
+ (org-element-line-break-successor, org-element-link-successor)
+ (org-element-plain-link-successor, org-element-macro-successor)
+ (org-element-radio-target-successor)
+ (org-element-statistics-cookie-successor)
+ (org-element-sub/superscript-successor)
+ (org-element-table-cell-successor, org-element-target-successor)
+ (org-element-timestamp-successor): Remove LIMIT argument.
+ (org-element--parse-objects, org-element--get-next-object-candidates):
+ Apply signature change to successors.
+ (org-element-context): Narrow buffer around object containers so
+ parsing of objects when using this function is done under the same
+ restrictions as in buffer parsing.
+
+ * ox.el (org-export-table-cell-alignment): Ensure required
+ variables are available. Use correct :test.
+ (org-export-table-cell-width): Modify key (now an element) and
+ value structure (now a vector) of cache so it can use `eq' as
+ test. Elements are circular lists so `equal' cannot apply on them.
+
+ * ox-publish.el (project-plist): Remove variable.
+
+ * ox.el (org-export-to-buffer, org-export-to-file): Fix
+ docstrings.
+
+ * ox-org.el (org-export-as-org): Add missing BODY-ONLY argument,
+ which is always nil in this back-end.
+
+ * org.el (org-adaptive-fill-function): Look for a fill prefix at
+ the beginning of the paragraph and subsquently on its second line
+ instead of the current line.
+
+ * ob-core.el (org-babel-get-src-block-info): Look for indentation
+ value at the correct location.
+
+ * ox.el (org-export-data-with-backend): Set temporary back-end as
+ the new back-end in local communication channel.
+ (org-export-filter-apply-functions): Handle corner case where
+ back-end is nil. Only provide back-end name (a symbol) as second
+ argument of filters, not the full back-end (a vector).
+
+ * ox-publish.el (org-publish-find-title): Fix title when no
+ #+TITLE property is provided.
+
+ * ox.el (org-export-store-default-title): Remove-function.
+ (org-export--default-title): Remove variable.
+ (org-export-options-alist): Do not use a default value.
+ (org-export--get-buffer-attributes): Store a default title.
+ (org-export-as): Apply function removal.
+ (org-export--get-global-options): Do not set a property with an
+ explicitely nil value.
+
+ * ox-publish.el (org-publish-sitemap-sort-files)
+ (org-publish-sitemap-sort-folders)
+ (org-publish-sitemap-ignore-case, org-publish-sitemap-requested)
+ (org-publish-sitemap-date-format)
+ (org-publish-sitemap-file-entry-format): Set prefix to
+ "org-publish-sitemap" instead of "org-sitemap".
+ (org-publish-compare-directory-files)
+ (org-publish-get-base-files-1, org-publish-projects)
+ (org-publish-format-file-entry): Use new prefix.
+
+ * org-clock.el (org-clock-total-time-cell-format)
+ (org-clock-file-time-cell-format): Use correct type.
+
+ * ob-haskell.el:
+ * ox-ascii.el (org-ascii-export-as-ascii)
+ (org-ascii-export-to-ascii):
+ * ox-beamer.el (org-beamer-export-as-latex)
+ (org-beamer-export-to-latex, org-beamer-export-to-pdf):
+ * ox-html.el (org-html-export-as-html, org-html-export-to-html):
+ * ox-icalendar.el (org-icalendar-export-to-ics):
+ * ox-latex.el (org-latex-export-as-latex)
+ (org-latex-export-to-pdf):
+ * ox-man.el (org-man-export-to-man, org-man-export-to-pdf):
+ * ox-md.el (org-md-export-as-markdown, org-md-export-to-markdown):
+ * ox-odt.el (org-odt-export-to-odt):
+ * ox-org.el (org-org-export-as-org, org-org-export-to-org):
+ * ox-publish.el (org-publish-org-to):
+ * ox-texinfo.el (org-texinfo-export-to-texinfo)
+ (org-texinfo-export-to-info):
+ * ox.el (org-export-to-buffer): Add two arguments: one to trigger
+ asynchronous export and the other to do extra processing from
+ within the buffer.
+ (org-export-to-file): Add two arguments: one to trigger
+ asynchronous export and the other to do extra processing on the
+ output file.
+ (org-export-async-start): Small clean up.
+
+ * ox.el (org-export-as): Use new back-end structure.
+ (org-export-current-backend): New variable.
+ (org-export-as): Use new variable.
+
+ * ox-ascii.el (org-ascii-table): Remove spurious new line between
+ a table and the caption below.
+
+ * ox.el (org-export-to-file): Preserve coding system when writing
+ output.
+ (org-export-stack-mode-map): Fix compilation error with Emacs <
+ 24.
+ (org-export--dispatch-action): Maintain compatibility with Emacs
+ 23.
+
+ * org.el (org-adaptive-fill-function, org-fill-paragraph): Add
+ support for `adaptive-fill-regexp' in paragraphs and comments.
+ (org-indent-line): Fix indentation after a list.
+
+ * ox.el (org-export--get-inbuffer-options): Multiple options can
+ now be set through the same buffer keyword.
+
+ * org-element.el (org-element-plain-list-parser): Fix infloop when
+ parsing a list at the end of buffer, if buffer doesn't end at a
+ line beginning.
+ (org-element-link-parser): Do not url-decode parsed links.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option): Remove
+ spurious white spaces, excepted for source blocks' opening string.
+ Small refactoring.
+ (pcomplete/org-mode/file-option): Remove spurious colons from
+ block boundaries.
+
+ * ox-publish.el (org-publish-find-date): Also return date for
+ directories.
+ (org-publish-get-base-files-1): Fix :recursive parameter ignoring
+ extension restriction.
+
+ * ox-beamer.el: Remove strange indentation in default header.
+ (org-beamer-template): Fix missing newlines in header.
+
+ * ox-latex.el (org-latex-template): Fix missing newlines in
+ header.
+
+ * ox.el (org-export-insert-default-template): Fix
+ "wrong-type-argument" error in template insertion.
+
+ * org.el (org-fill-paragraph): Use empty commented lines as
+ separators when filling comments. This mimics default behaviour
+ from "newcomment.el", which is not used in Org.
+
+ * ox-html.el (org-html-link): Add image attributes to "img" tag,
+ not to the "a" container. Also fix spacing for attributes.
+
+ * org.el (org-fill-paragraph): Do not mix consecutive comments
+ when filling any of them.
+
+ * ox-html.el (org-html-format-headline--wrap): Fix number of
+ arguments when setting `org-html-format-headline-function'.
+
+ * org-element.el (org-element-item-interpreter): This patch fixes
+ "(wrong-type-argument arrayp nil)" error when trying to interpret
+ empty items. Correctly interpret back plain lists with "*" items.
+ This fixes "This is not a list" error returned in this case.
+
+ * ox-latex.el (org-latex-listings): Update docstring.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option/options): Apply
+ changes to export back-end definiton.
+
+ * org.el (org-get-export-keywords): Apply changes to export
+ back-end definiton.
+
+ * ox-html.el (org-html--format-toc-headline): Make use of
+ anonymous back-ends.
+
+ * ox-odt.el (org-odt-footnote-reference): Make use of anonymous
+ back-ends.
+ (org-odt-format-label, org-odt-toc)
+ (org-odt-format-headline--wrap): Use `org-export-with-backend'
+ instead of `org-export-with-translations'.
+
+ * ox.el (org-export--registered-backends): Renamed from
+ `org-export-registered-backends'.
+ (org-export-invisible-backends): Removed variable.
+ (org-export-get-backend, org-export-get-all-transcoders
+ org-export-get-all-options, org-export-get-all-filters): New
+ functions. It replaces `org-export-backend-translate-table'.
+ (org-export-barf-if-invalid-backend, org-export-derived-backend-p,
+ org-export-define-backend, org-export-define-derived-backend):
+ Rewrite functions using new representation.
+ (org-export-backend-translate-table): Remove function.
+ (org-export-get-environment): Use new function.
+ (org-export--get-subtree-options, org-export--parse-option-keyword,
+ org-export--get-inbuffer-options, org-export--get-global-options,
+ org-export-to-buffer org-export-to-file, org-export-string-as
+ org-export-replace-region-by): Update docstring.
+ (org-export-data-with-translations): Remove function. Use
+ `org-export-data-with-backend' with a temporary back-end instead.
+ (org-export-data-with-backend, org-export-as): Reflect new definition
+ for back-ends.
+ (org-export--dispatch-action, org-export--dispatch-ui): Reflect new
+ definition for back-ends and variable removal. Refactoring.
+ (org-export-filter-apply-functions): Call functions with
+ current back-end's name, not full back-end.
+
+ * org.el (org-export-backends, org-create-formula--latex-header):
+ Use new structure and variables.
+
+ * ox-html.el (org-html-inline-images): Change default value and
+ remove `maybe'.
+ (org-html-format-inline-image): Remove functions.
+ (org-html--wrap-image, org-html--format-image)
+ (org-html-inline-image-p): New functions.
+ (org-html-latex-environment, org-html-latex-fragment): Use new
+ functions.
+ (org-html-standalone-image-p): Use new functions. Also remove an
+ unused optional argument.
+ (org-html-link, org-html-paragraph): Correctly export hyperlinked
+ images.
+
+ * ox.el (org-export-dictionary): Update some translations.
+
+ * ox-odt.el (org-odt-label-styles, org-odt-category-map-alist):
+ Fix docstring.
+ (org-odt-format-label): Add docstring. Internationalize prefix.
+
+ * ox.el (org-export-dictionary): Add entry for colons.
+
+ * ox-odt.el (org-odt--suppress-some-translators): Remove function.
+
+ * ox-html.el (org-html-link): Remove left-over binding.
+
+ * ox-beamer.el (org-beamer-environments-extra): Allow to add raw
+ title in environment definition.
+ (org-beamer--format-block): Handle new placeholders.
+
+ * ox-html.el (org-html-link): Small refactoring.
+
+ * org-element.el (org-element--current-element): Fix
+ org-meta-return error at the end of buffer.
+
+ * ox-odt.el (org-odt-category-map-alist): Fix internationalization
+ of "Table" and "Listing".
+
+ * ox.el (org-export-dictionary): Remove useless dictionary
+ entries.
+
+ * ox-ascii.el (org-ascii--build-caption): Apply removal.
+
+ * ox.el (org-export-dictionary): Add spanish and german
+ translations.
+
+ * ox-odt.el (org-odt-link): Fuzzy links to an headline with a
+ description always use that description, even if the description
+ is the same as the headline title.
+ (org-odt-plain-text): Allow to turn smart quotes off.
+
+ * ox-latex.el (org-latex--get-footnote-counter): Remove function.
+
+ * org.el (org-setup-filling): Set `paragraph-start' and
+ `paragraph-separate'.
+ (org-fill-paragraph-separate-nobreak-p): Remove function.
+ (org-mode): Do not set `paragraph-start'.
+
+ * ox-html.el (html): Replace "HTML_HTML5_FANCY",
+ "HTML_INCLUDE_STYLE" and "HTML_INCLUDE_SCRIPTS" with,
+ respectively, ":html5-fancy", "html-style" and "html-scripts"
+ options.
+ (org-html-html5-fancy): Reformat docstring.
+ (org-html-template): Fix typo preventing insertion of link up/link
+ home anchors.
+
+ * org.el (org-create-formula--latex-header): Replace AUTO with
+ appropriate language when previewing snippets.
+
+ * ox-latex.el (org-latex-item): Allow hyperref and footnotemark in
+ items description tags. Also remove a unnecessary hack allowing
+ footnotemark with an optional argument in the tag.
+
+ * ox.el (org-export-resolve-fuzzy-link): Fix link resolution when
+ link lives before the first headline.
+
+ * org-element.el (org-element-special-block-parser): Fix typo in
+ regexp matching block type. Also quote the type so it can contain
+ special characters.
+
+ * ox-latex.el (org-latex-pdf-process): This argument can cause
+ problem with links with a relative path, since compilation happens
+ in a different directory.
+
+ * org.el (org-latex-default-packages-alist): Load "ulem" package
+ by default. Use "[normalem]" option to preserve \emph definition.
+
+ * ox-latex.el (org-latex-text-markup-alist): Use "\uline" and
+ "\sout" commands from "ulem" package.
+
+ * org.el (org-latex-default-packages-alist): Document need for
+ "soul" package.
+
+ * ox-latex.el (org-latex-text-markup-alist): Use \ul (from "soul"
+ package) instead of \underline for underline text.
+
+ * ox.el (org-export-read-attribute): Fix "Wrong argument type"
+ error when attributes start with :key "".
+
+ * org.el (org-fill-paragraph-separate-nobreak-p)
+ (org-fill-line-break-nobreak-p)
+ (org-fill-paragraph-with-timestamp-nobreak-p): Fix docstrings.
+
+ * org-element.el (org-element--list-struct): Fix failing
+ "plain-list-parser" test.
+
+ * ox-latex.el (org-latex-src-block): Handle :float attribute. Its
+ value can be set to "t", "multicolumn" or "nil". Also remove
+ :long-listing attribute, which is now replaced with :float nil.
+ (org-latex--org-table): Replace :float table with :float t.
+ (org-latex--inline-image): Replace :float figure with :float t.
+ (org-latex-long-listings): Remove variable.
+
+ * org-element.el (org-element--list-struct): New function.
+ (org-element-plain-list-parser, org-element--current-element): Use
+ new function.
+
+ * ox-man.el (org-man-compile):
+ * ox-texinfo.el (org-texinfo-compile): Use appropriate argument.
+
+ * ox-latex.el (org-latex-compile):
+ * ox-man.el (org-man-compile):
+ * ox-texinfo.el (org-texinfo-compile): Properly set working
+ directory.
+
+ * ox-latex.el (org-latex-compile):
+ * ox-texinfo.el (org-texinfo-compile): Make sure generated file
+ can be found by `file-exists-p'.
+
+ * ox-md.el (md): Delegate underscore transcoding to HTML back-end.
+
+ * org-element.el (org-element--remove-indentation): Small
+ optimization.
+ (org-element--remove-indentation): New function.
+ (org-element-example-block-parser, org-element-src-block-parser):
+ Use new function.
+ (org-element-src-block-interpreter): Update function according to
+ change.
+
+ * ox.el (org-export-unravel-code): Do not remove any indentation
+ since it now happens at the parser level.
+ (org-export-table-cell-width): Be sure to use cache even when
+ stored value is nil.
+ (org-export--default-title): Fix "Symbol's value as variable is
+ void: org-export--default-title".
+
+ * ox-ascii.el (org-ascii--table-cell-width): Cache results of this
+ internal function since it is called at each cell, though its
+ value only change column wise.
+
+ * ox.el (org-export-resolve-fuzzy-link): Change property name
+ holding cache.
+ (org-export-table-has-header-p, org-export-table-row-group)
+ (org-export-table-cell-width, org-export-table-cell-alignment):
+ Cache results.
+ (org-export-table-cell-address): Refactor.
+ (org-export-get-parent): Inline function.
+ (org-export-options-alist): Change default value for :title
+ property.
+ (org-export--default-title): New dynamically scoped variable.
+ (org-export-store-default-title): New function.
+ (org-export--get-buffer-attributes): Remove title handling.
+ (org-export--get-global-options): Revert "ox: Fix default title".
+ Refactor code.
+
+ * ox-html.el (org-html-format-latex): Provide a prefix for
+ temporary file when using dvipng, even if the current buffer isn't
+ associated to a file.
+
+ * ox.el (org-export-resolve-radio-link): Ignore whitespace
+ differences when resolving a radio link.
+ (org-export-resolve-radio-link): Fix radio target resolution.
+
+ * org-element.el (org-element--current-element): Be stricter when
+ matching arguments in LaTeX environments. In particular, do not
+ allow anything else than options and arguments in the opening
+ line.
+
+ * ox-html.el (org-html-inner-template): Remove code relative to
+ bibliography.
+ (org-html-bibliography): Remove function.
+
+ * ox-latex.el (org-latex-plain-text): Protect ^ char with \^{},
+ not only \^, so it doesn't become a diacritic.
+
+ * ox-html.el (org-html--build-meta-info): Fix code typo.
+
+ * ox.el (org-export-expand-include-keyword): Avoid using `read' to
+ determine file name.
+ (org-export--get-global-options): Properly set default title,
+ i.e. when to TITLE keyword is provided.
+
+ * org-element.el (org-element--parse-elements): Also parse visible
+ headlines within an otherwise compacted headline.
+
+ * ox.el (org-export-expand-include-keyword): Tolerate included
+ file names without double quotes.
+ (org-export-resolve-fuzzy-link): Fix caching process.
+
+ * ox-publish.el (org-publish-find-date): Fix "Invalid time
+ specification" error with timestamps in DATE.
+
+ * org-element.el (org-element--current-element): Allow the opening
+ string of a LaTeX environment to contain additional arguments.
+
+ * org.el (org-insert-heading): Refactor to use `org-in-item-p'
+ only once.
+
+ * ox.el (org-export-expand): Optionally add affiliated keywords to
+ results.
+
+ * ox-org.el (org-org-identity): Use new argument for
+ `org-export-expand'.
+
+ * org.el (org-fill-paragraph): Move to table beginning before
+ aligning the table when M-q is called from an affiliated keyword.
+
+ * org-list.el (org-list-allow-alphabetical): Properly update
+ `org-list-allow-alphabetical' when changed after org.el has been
+ loaded.
+
+ * org-element.el (org-element-fixed-width-interpreter): Fix
+ interpretation of fixed-width elements with a nil or empty string
+ value.
+
+ * ox-html.el (org-html-link): Don't skip the link description when
+ it matches the name of the headline it targets.
+
+ * ox-html.el (org-html-link): Don't skip the link description when
+ it matches the name of the headline it targets.
+
+ * ox-ascii.el (ascii): Remove inexistant function.
+
+ * ox-icalendar.el (icalendar): Ignore footnotes.
+ (org-icalendar--combine-files): Small refactoring.
+
+ * ox.el (org-export--skip-p, org-export--interpret-p): When
+ `org-export-with-footnotes' is nil, ignore completely footnotes
+ references and definitions instead of exporting them verbatim.
+
+ * ox-beamer.el (org-beamer--frame-level): Small refactoring.
+ (org-beamer--format-block, org-beamer-headline): Do not systematically
+ downcase environment names as some require upper case in their
+ names (e.g. noteNH and CJK).
+
+ * ox.el (org-export-with-timestamps): Only applies to isolated
+ timestamps, i.e. timestamps in a paragraph containing only
+ timestamps and empty strings.
+ (org-export--skip-p): Skip timestamps according to new behaviour.
+
+ * ox-latex.el (org-latex--script-size): Handle consecutive
+ alterning sub and superscript.
+
+ * ox-org.el (org-org-identity): Fix docstring. Tiny refactoring.
+ (org-org-headline, org-org-keyword): Fix docstring.
+
+ * ox-latex.el (org-latex--script-size): Use \text command for
+ subscript and superscript. This is far superior to \mathrm, but
+ it requires "amstext" package. In particular, accented characters
+ are now allowed within sub/superscript.
+
+ * org.el (org-latex-default-packages-alist): Add "amstext"
+ package.
+
+ * ox-latex.el (org-latex--script-size): Fix error when using
+ sub/superscript within sub/superscript.
+
+ * ox-latex.el (org-latex--script-size): New function.
+ (org-latex-subscript, org-latex-superscript): Use new function.
+ Remove instructions since everything is documented in Org manual.
+
+ * ox.el (org-export-with-smart-quotes): Use LATEX instead of LaTeX
+ for keywords, the latter being hard to type, somewhat difficult to
+ read, and overall just pedantic.
+
+ * ox-latex.el (org-latex-classes): Be more explicit about
+ LATEX_HEADER_EXTRA.
+
+ * ox-html.el (org-html--build-meta-info): Fix invalid characters
+ in html attributes.
+
+ * ox.el (org-export-filters-alist): Remove macro filter.
+ (org-export-filter-macro-functions): Remove variable.
+
+ * ox-beamer.el (beamer): Install a default class set-up when
+ loading library.
+
+ * ox-latex.el (org-latex-classes): Update docstring.
+
+ * ox-latex.el (org-latex--inline-image): Remove specific default
+ image width for floats. If no width nor height is provided, it
+ should default to `org-latex-image-default-width' value.
+
+ * org.el (org-extract-attributes-from-string)
+ (org-attributes-to-string): Remove functions.
+
+ * ox-html.el (html): Rename :html-table-tag property into
+ :org-table-attributes.
+ (org-html-table-default-attributes): New variable.
+ (org-html-table-tag): Removed variable.
+ (org-html--make-attribute-string): New function.
+ (org-html-link--inline-image, org-html-table): Use new function.
+ (org-html-splice-attributes, org-export-splice-style): Remove
+ functions.
+ (org-html-inline-image-rules): Remove out of context part of the
+ docstring.
+
+ * ox.el (org-export-read-attribute): Allow to use empty strings in
+ attributes.
+
+ * ox-html.el (org-html-metadata-timestamp-format): New variable,
+ renamed from `org-html--timestamp-format'.
+ (org-html--build-meta-info, org-html-format-spec,
+ org-html--build-pre/postamble): Use new variable.
+
+ * ox.el (org-export-table-row-number): New function.
+ (org-export-table-cell-address): Use new function.
+
+ * org-element.el (org-element-table-cell-successor): Parse table
+ cells with missing ending space.
+
+ * ox-latex.el (org-latex--math-table): Fix inline-math table
+ environment.
+
+ * ox-html.el (org-html-doctype): Make value fit on a single line
+ so `org-export-insert-default-template' can handle it.
+ (org-html-creator-string): Change default value.
+
+ * ox.el (org-export-creator-string): Change default value.
+
+ * ox-html.el (org-html-postamble-format)
+ (org-html-preamble-format): Allow last modification time of source
+ in template. Fix docstrings.
+ (org-html-format-spec): Produce last modification time when the source
+ is a file.
+
+ * ox.el (org-export-with-archived-trees, org-export-with-author)
+ (org-export-with-clocks, org-export-with-date)
+ (org-export-creator-string, org-export-with-drawers)
+ (org-export-with-email, org-export-with-emphasize)
+ (org-export-exclude-tags, org-export-with-fixed-width)
+ (org-export-with-footnotes, org-export-with-latex)
+ (org-export-headline-levels, org-export-default-language)
+ (org-export-preserve-breaks, org-export-with-entities)
+ (org-export-with-inlinetasks, org-export-with-planning)
+ (org-export-with-priority, org-export-with-section-numbers)
+ (org-export-select-tags, org-export-with-smart-quotes)
+ (org-export-with-special-strings)
+ (org-export-with-statistics-cookies)
+ (org-export-with-sub-superscripts, org-export-with-toc)
+ (org-export-with-tables, org-export-with-tags)
+ (org-export-with-tasks, org-export-time-stamp-file)
+ (org-export-with-timestamps, org-export-with-todo-keywords): Fix
+ docstrings.
+
+ * ox-html.el (org-html-postamble-format): Slightly change default
+ value so "Generated by" string doesn't get duplicated.
+ (org-html-creator-string): Fix docstring.
+
+ * ox.el (org-export--get-inbuffer-options)
+ (org-export--list-bound-variables)
+ (org-export--generate-copy-script, org-export-string-as)
+ (org-export-expand-include-keyword)
+ (org-export--prepare-file-contents): Inhibit startup process when
+ calling `org-mode'.
+
+ * ox-publish.el (org-publish-find-date): Fix "bad timestamp" error
+ with some DATE values: :date property in communication channel is
+ no longer a string.
+
+ * ox.el (org-export-insert-default-template): New function.
+ (org-export--dispatch-ui, org-export--dispatch-action): Access to
+ the function through the dispatcher.
+
+ * ox-icalendar.el (org-icalendar-convert-timestamp): Update
+ docstring.
+ (org-icalendar-dtstamp): New function.
+ (org-icalendar--vevent, org-icalendar--vtodo): Use new function.
+
+ * ox-ascii.el (org-ascii-link):
+ * ox-html.el (org-html-keyword):
+ * ox-latex.el (org-latex-keyword, org-latex-link):
+ * ox-man.el (org-man-keyword):
+ * ox-md.el (org-md-link):
+ * ox-odt.el (org-odt-keyword):
+ * org.el (org-store-link, org-link-search, org-options-keywords):
+ Remove reference to TARGET keyword.
+
+ * ox.el (org-export-resolve-fuzzy-link, org-export-get-ordinal):
+ Do not use TARGET as a destination for links anymore.
+
+ * ox-org.el (org): Add a menu entry for the back-end.
+ (org-org-export-as-org, org-org-export-to-org): New functions.
+
+ * org.el (org-export-backends): Accept `org' as a loadable
+ back-end.
+
+ * ox-ascii.el (org-ascii-template--document-title): Use new function.
+
+ * ox-beamer.el (org-beamer-template): Use new function.
+
+ * ox-html.el (org-html-format-spec): Use new function.
+
+ * ox-latex.el (org-latex-template): Use new function.
+ (org-latex-date-timestamp-format): Remove variable.
+
+ * ox.el (org-export-date-timestamp-format): New variable.
+ (org-export-get-date): New function.
+
+ * ox-odt.el (org-odt--format-paragraph): New function.
+ (org-odt-paragraph): Use new function to limit code duplication.
+ (org-odt-footnote-reference): Change default style for paragraphs
+ when transcoding a footnote definition.
+
+ * org-macro.el (org-macro--collect-macros): Fix a bug where
+ reading a macro in a setup file would remove other macros read so
+ far from template. Change function signature.
+ (org-macro-initialize-templates): Apply signature change from function
+ above.
+
+ * ox.el (org-export--list-bound-variables): Renamed from
+ `org-export--install-letbind-maybe'. Though, only return list of
+ bound variables instead of installing them as buffer-local
+ variables.
+ (org-export-get-environment): Use new function. Take care of the
+ installation of bound variables.
+ (org-export--generate-copy-script): Make sure non-Org variables are
+ also installed in buffer copy.
+
+ * ox.el (org-export-get-environment): Update comment.
+ (org-export--install-letbind-maybe): Go into SETUPFILE files and
+ handle BIND keywords there.
+
+ * ox-latex.el (org-latex-link): Do not prefix relative paths with
+ "file://".
+
+ * org.el (org-link-search): Preserve priority of #+TARGET over
+ #+NAME when resolving a link.
+
+ * ox-latex.el (org-latex-long-listings): New variable.
+ (org-latex-src-block): Use new variable.
+
+ * ox.el (org-export-data): White spaces after export snippets are
+ never ignored.
+
+ * org-element.el (org-element-macro-parser): Allow to escape
+ escaping character before a comma. Also do not trim spaces at
+ argument boundaries.
+
+ * ox.el (org-export-async-start): Use correct coding system so
+ unibyte characters do not appear in the resulting buffer or file.
+ (org-export--copy-to-kill-ring-p): Move function elsewhere in the
+ file.
+
+ * ox-latex.el (org-latex--inline-image): Fix error when no default
+ width, height and option are provided and no attribute is set for
+ the inline image.
+
+ * org.el (org-comment-or-uncomment-region): Fix commenting lines
+ beginning with a link.
+ (org-delete-char): Fix "Invalid use of `\\' in replacement text"
+ when deleting a character in a cell which contains "\"
+ (org-export-backends): Remove duplicates. Reorder alphabetically.
+
+ * ox-texinfo.el (org-texinfo-plain-list): Use `member' instead of
+ `memq' when matching strings.
+
+ * ox.el (org-export-read-attribute): Do not use `read' to read
+ attributes. Instead, extract keywords and values from it, which
+ means each value will be a string when non-nil.
+
+ * ox-beamer.el (org-beamer-plain-list): Use new attribute syntax.
+
+ * ox-html.el (org-html--textarea-block): Use new attribute syntax.
+
+ * ox-latex.el (org-latex--inline-image, org-latex--org-table)
+ (org-latex--math-table): Use new attribute syntax.
+
+ * ox-man.el (org-man-table--org-table): Use new attribute syntax.
+ Small refactoring.
+
+ * ox-odt.el (org-odt-link--inline-image, org-odt-table-cell): Use
+ new attribute syntax.
+
+ * ox.el (org-export-async-start): Remove code evaluation queries
+ from asynchronous export.
+
+ * ox-latex.el (latex): Activate smart quotes by default.
+ (org-latex--inline-image): Don't insert a default width when
+ height is provided in a figure environment.
+ (org-latex--inline-image): Do not use default width
+ (resp. height) when an user height (resp. width) is provided.
+ Also, default height is only used when image is not wrapped within
+ a figure or wrapfigure environment, in order to preserve ratio.
+ (org-latex-image-default-width, org-latex-image-default-height):
+ Update docstring.
+
+ * ox-icalendar.el (org-icalendar-create-uid): Fix error when
+ `org-icalendar-store-UID' is non-nil.
+
+ * ox-latex.el (latex): Introduce new buffer keyword.
+ (org-latex-template): Use new keyword.
+
+ * ox-beamer.el (org-beamer-template): Use new keyword.
+
+ * org.el (org-create-formula--latex-header): Use new keyword.
+
+ * ox-beamer.el (org-beamer-column-view-format, org-beamer-theme)
+ (org-beamer-environments-extra): Add :version and
+ :package-version.
+
+ * ox-html.el (org-html-with-latex, org-html-inline-image-rules):
+ Add :version and :package-version.
+
+ * ox-latex.el (org-latex-inline-image-rules)
+ (org-latex-default-table-environment)
+ (org-latex-default-table-mode, org-latex-tables-booktabs)
+ (org-latex-table-scientific-notation, org-latex-known-errors): Add
+ :version and :package-version.
+
+ * ox-md.el (org-md-headline-style): Add :version and
+ :package-version.
+
+ * ox-odt.el (org-odt-with-latex): Add :version
+ and :package-version.
+
+ * ox.el (org-export-with-drawers, org-export-with-latex)
+ (org-export-with-inlinetasks, org-export-with-planning)
+ (org-export-with-smart-quotes, org-export-with-statistics-cookies)
+ (org-export-allow-bind-keywords, org-export-async-init-file): Add
+ :version and :package-version.
+
+ * ox-icalendar.el (org-icalendar-export-to-ics): Change back-end
+ name from `e-ascii' to `ascii'.
+
+ * ox.el (org-export--generate-copy-script): Call `org-mode' when
+ duplicating a buffer. It will properly set every variable, like
+ `comment-start'.
+ (org-export-async-start): Do not call `org-mode' since this is done
+ already in the previous function.
+
+ * ox-beamer.el (org-beamer-keyword): Remove frame arount toc when
+ generated from a TOC keyword.
+
+ * org.el (org-export-backends): Do not reset list of loaded
+ back-ends to variable's value after a reload.
+
+ * ox-latex.el (org-latex-src-block): Do not overwrite provided
+ numbering options in minted and listings.
+ (org-latex-headline): Don't add optional title on unnumbered
+ headlines.
+
+ * ox-html.el (html): Fix "HTML_HEAD" and "HTML_HEAD_EXTRA"
+ keywords. Allow multiple #+LATEX_HEAD and #+LATEX_HEAD_EXTRA
+ again.
+
+ * org.el (org-fill-paragraph): Small refactoring to
+ `org-fill-paragraph'. Do not look for table cells in a paragraph.
+
+ * org-element.el (org-element-object-restrictions): Simplify
+ restrictions within secondary strings and objects.
+
+ * org-list.el (org-list-send-list): Do not rely on
+ `org-list-parse-list'.
+ (org-list-to-latex, org-list-to-html, org-list-to-texinfo): Use
+ appropriate export back-end instead of using
+ `org-list-to-generic'.
+
+ * ox-html.el (org-html-inner-template): Remove contents div and
+ title.
+ (org-html-template): Add contents div and title.
+ (org-html-infojs-install-script): Can't activate jsinfo script
+ during a body-only export.
+
+ * ox.el (org-export-as): Store export options in :export-options
+ porperty within communication channel.
+
+ * ox-latex.el (org-latex-item): Fix wrong behaviour when a counter
+ is set in an ordered list while its parent is not ordered.
+
+ * ox.el (org-export-format-code-default): Handle empty source
+ blocks more gracefully.
+
+ * ox-ascii.el (org-ascii-src-block): Handle empty blocks more
+ gracefully.
+
+ * org.el (org-export-backends): Update variable. `infojs' was
+ merged into ox-html and `freemind' was added.
+
+ * ox.el (org-export--selected-trees): Also mark inlinetasks with a
+ select tag.
+ (org-export--skip-p): Skip inlinetasks with a :noexport: tag.
+
+ * ob-tangle.el (org-babel-spec-to-string): Use dedicated function
+ for unescaping code.
+
+ * ox-html.el (org-html-link): Silence byte-compiler.
+ (html): Add infojs installation script in options filter.
+ (org-html-infojs-install-script): Remove check for back-end as we
+ can safely assume the function will be called from `html' back-end
+ or one of its derivative.
+
+ * ox-icalendar.el (org-agenda-collect-markers)
+ (org-create-marker-find-array): Remove functions.
+ (org-icalendar-export-current-agenda): Integrate previous
+ functions.
+
+ * ox-latex.el (org-latex-format-headline-default-function): Use
+ declarative shape to nest makup for TODO keywords. Previous
+ syntax generated errors during export.
+
+ * ox.el (org-export-async-start): Ignore `org-mode-hook' and
+ `kill-emacs-hook'. The first one has been run in the original
+ buffer. The second is not necessary and can pollute output to a
+ temporary buffer (e.g. with `org-clock-persistence-insinuate').
+
+ * ox-html.el (org-html-inner-template): Remove title.
+ (org-html-template): Add title.
+
+ * ox.el (org-export--get-min-level): Ignore footnote section when
+ computing minimal headline level.
+
+ * org.el (org-do-latex-and-related): Fix infloop when user
+ provides a wrong value for `org-highlight-latex-and-related'. In
+ this case, `org-latex-and-related-regexp' is the empty string and
+ generates an infloop since matching it doesn't move point.
+
+ * org-element.el (org-element-headline-parser): Rename
+ :optional-title into :alt-title.
+
+ * ox.el (org-export-get-alt-title): Renamed from
+ `org-export-get-optional-title'.
+
+ * ox-ascii.el (org-ascii--build-title):
+ * ox-html.el (org-html--format-toc-headline):
+ * ox-latex.el (org-latex-headline):
+ * ox-texinfo.el (org-texinfo--get-node)
+ (org-texinfo--generate-menu-items): Apply name change.
+
+ * ox.el (org-export--get-inbuffer-options): Remove an optional
+ argument. Rewrite function. Properties read from a setupfile do
+ not overwrite anymore previously computed properties.
+ (org-export-get-environment): Apply changes to previous function.
+
+ * org.el (org-create-formula--latex-header): Apply arity change
+ from `org-export--get-inbuffer-options'.
+
+ * ox-latex.el (org-latex-compile): Add an optional argument for
+ latex snippet previewing.
+
+ * org.el (org-create-formula-image-with-imagemagick): Use
+ `org-latex-compile' instead of rewriting it.
+
+ * ox-html.el (org-html-fontify-code): Do not use [^\000] in
+ regexps that may match large strings.
+
+ * org.el (org-create-formula--latex-header): New function.
+ (org-create-formula-image-with-dvipng)
+ (org-create-formula-image-with-imagemagick): Use new function.
+
+ * ox.el (org-export-get-previous-element): Change order of retured
+ elements in `org-export-get-previous-element'.
+
+ * org-element.el (org-element-all-successors): Add `plain-link'
+ successor.
+ (org-element-object-restrictions): Remove `link' within `link'.
+ Allow `plain-link' instead.
+ (org-element-plain-link-successor): New function.
+
+ * org.el (org-match-substring-regexp)
+ (org-match-substring-with-braces-regexp): Update regexp. A
+ sub/superscript cannot start anymore at the beginning of the line
+ or after a space.
+
+ * org-element.el (org-element--get-next-object-candidates):
+ Rewrite function to simplify algorithm.
+ (org-element-context, org-element--parse-elements): Apply changes.
+
+ * org.el (org-fill-paragraph): Apply changes.
+
+ * ox-html.el (org-html-link, org-html-link--inline-image):
+ Attributes specified to a paragraph only apply to first link
+ within.
+
+ * ox-latex.el (org-latex-headline): Do not add optional section
+ name when section is unnumbered.
+
+ * org.el (org-in-verbatim-emphasis): Fix false positive when point
+ is just after the closing emphasis marker.
+ (org-fill-paragraph): Do not move point when filling a table.
+
+ * ox-ascii.el (ascii): Add new filter.
+ (org-ascii-filter-comment-spacing): New function.
+ (org-latex-keyword): Remove "figures" value.
+
+ * ox-ascii.el (org-ascii--list-tables): Fix docstring.
+
+ * ox-html.el (org-html--format-toc-headline): Fix function name.
+ (org-html-toc, org-html--toc-text): Change to docstring.
+ (org-html-list-of-listings, org-html-list-of-tables): New
+ functions.
+ (org-html-keyword): Use new functions.
+ (org-html-src-block): Add an ID attribute when a name is given.
+
+ * org-element.el (org-element-footnote-definition-parser): Require
+ 2 blank lines to separate footnote definition.
+
+ * org-footnote.el (org-footnote-at-definition-p): Require 2 blank
+ lines to separate footnote definition.
+
+ * ox.el (org-export-stack): Rewrite.
+ (org-export-stack-refresh): Refactor.
+ (org-export-stack-remove, org-export-stack-view): Apply renaming.
+ (org-export-stack-mode-map): Use tabulated list map as a basis.
+ (org-export-stack--generate, org-export-stack--num-predicate): New
+ function.
+ (org-export-get-optional-title): Return regular title when no
+ optional title is found.
+
+ * ox-ascii.el (org-ascii--build-title): Apply change to
+ `org-export-get-optional-title'.
+
+ * ox-html.el (org-html--format-toc-headline): Apply change to
+ `org-export-get-optional-title'.
+
+ * ox-latex.el (org-latex-headline): Apply change to
+ `org-export-get-optional-title'.
+
+ * ox-ascii.el (org-ascii--build-title): Add an argument. Use
+ optional title when building a toc line.
+ (org-ascii--build-toc): Call `org-ascii--build-title' with
+ appropriate arguments.
+
+ * ox-latex.el (org-latex-headline): Use optional title for table
+ of contents.
+
+ * ox-html.el (org-html--toc-text): Renamed from
+ `org-html-toc-text'. Add docstring.
+ (org-html--format-toc-headline): Renamed from
+ `org-html-format-toc-headline'. Add docstring. Use optional
+ title if possible.
+ (org-html-toc): Add docstring.
+
+ * org-element.el (org-element-headline-parser): Node property
+ :OPTIONAL_TITLE: in a headline will be parsed and stored under
+ :optional-title property.
+
+ * ox.el (org-export-get-optional-title): New function.
+
+ * ox-latex.el (org-latex-format-headline-default-function): Make
+ the variable a function.
+
+ * ox-publish.el (org-publish-resolve-external-fuzzy-link): No
+ error when resolving external fuzzy links outside publishing.
+ Though search option for these links will not be resolved.
+
+ * ox-latex.el (org-latex-guess-inputenc): Set inputenc option
+ according to `org-export-coding-system'.
+
+ * ox.el (org-export--generate-copy-script): Clone
+ `buffer-file-coding-system' when creating a buffer copy.
+
+ * ox-html.el (org-html-link): Resolve external links with search
+ options like [[file.org::#custom-id]] or
+ [[file.org::*headline-search]].
+
+ * ox-publish.el (org-publish-collect-numbering)
+ (org-publish-resolve-external-fuzzy-link): New functions.
+ (org-publish-org-to): Add new collecting function to final output
+ filter. Move index collecting function to the same filter.
+ (org-publish-collect-index): Called from final output filter.
+
+ * ox-html.el (org-html-format-headline--wrap, org-html-headline):
+ Use :CUSTOM_ID, not :custom-id.
+
+ * org-element.el (org-element-latex-environment-parser): Fix wrong
+ value for :post-affiliated property when parsing a latex
+ environment.
+
+ * ox-latex.el (org-latex-property-drawer): Remove function.
+
+ * ox-ascii.el (org-ascii-filter-paragraph-spacing): Remove
+ reference to now renamed `e-ascii' back-end.
+
+ * ox-beamer.el (org-beamer-template): Allow to span documentclass
+ options accross multiple lines in template.
+
+ * ox-latex.el (org-latex-template): Allow to span documentclass
+ options accross multiple lines in template.
+
+ * ox-texinfo.el (org-texinfo--get-node): Upcase property name.
+ (org-texinfo--get-node): New function.
+ (org-texinfo-headline, org-texinfo-link): Use new function.
+
+ * ox-ascii.el (org-ascii-quote-block): Do not fill quote block
+ contents. Just indent them.
+
+ * ox-publish.el (org-publish-index-generate-theindex): Do not
+ create an "* Index" headline in "theindex.inc". Though, create an
+ "Index" title in fallback "theindex.org".
+
+ * ox-publish.el (org-publish-projects): Publish "theindex.org"
+ last, so that "theindex.inc" can be completed.
+
+ * ox-publish.el (org-publish-project-alist): Fix docstring.
+ (org-publish-collect-index): Fix typo.
+
+ * ox.el (org-export--dispatch-ui): Prevent invisible cursor from
+ highlighting brackets in UI
+
+ * org-element.el (org-element-headline-parser)
+ (org-element-inlinetask-parser): Fix docstring.
+
+ * org.el (org-export-backends): Add new back-end in customize
+ interface.
+
+ * ox-beamer.el (org-beamer--get-label, org-beamer--frame-level)
+ (org-beamer--format-section, org-beamer--format-frame)
+ (org-beamer--format-block, org-beamer-headline): Apply changes to
+ properties.
+
+ * ox-html.el (org-html-headline, org-html-link, org-html-section):
+ Apply changes to properties.
+
+ * ox-icalendar.el (org-icalendar-create-uid)
+ (org-icalendar-blocked-headline-p, org-icalendar-entry)
+ (org-icalendar--valarm): Apply changes to properties.
+
+ * ox-odt.el (org-odt-headline): Apply changes
+
+ * ox-publish.el (org-publish-collect-index): Apply changes to
+ properties.
+
+ * ox-texinfo.el (org-texinfo--generate-menu-list)
+ (org-texinfo--generate-menu-items, org-texinfo-template)
+ (org-texinfo-headline, org-texinfo-link): Apply changes to
+ properties.
+
+ * ox.el (org-export-resolve-id-link, org-export-get-category):
+ Apply changes to properties.
+ (org-export-get-node-property): Update docstring.
+
+ * org-element.el (org-element-headline-parser)
+ (org-element-inlinetask-parser): Upcase properties. This is done
+ to avoid confusion between properties from parser (e.g. `:end')
+ and properties from the property drawer (e.g. :END:).
+
+ * ox-publish.el (org-publish-index-generate-theindex): Preserve
+ order in file. Fix error when two index entries were identical.
+ Create again theindex.inc.
+
+ * org-element.el (org-element-map): Allow to map over any list.
+ Do not restrict mapping to object types.
+
+ * org-faces.el (org-latex-and-related): Renamed from
+ `org-latex-and-export-specials', which wasn't appropriate anymore.
+
+ * org.el (org-highlight-latex-and-related)
+ (org-latex-and-related-regexp): New variables.
+ (org-compute-latex-and-related-regexp, org-do-latex-and-related): New
+ function, revived from a previous commit.
+ (org-set-regexps-and-options, org-set-font-lock-defaults): Use new
+ functions.
+ (org-set-regexps-and-options): Remove reference to LATEX_CLASS and
+ beamer back-end.
+
+ * ox-publish.el (org-publish-org-to): Small refactoring.
+
+ * ox.el (org-export-install-filters): Properly install filters
+ send through ext-plist mechanism.
+
+ * ox-publish.el (org-publish-org-to): Small refactoring.
+
+ * ox-html.el (org-html-keyword): Remove INDEX keyword handling.
+ ox-publish.el takes care of it already.
+
+ * org-macro.el: New file.
+
+ * org.el: Remove macro code.
+
+ * ox.el: Require new library
+
+ * ox.el (org-export-resolve-fuzzy-link): Ignore statistics cookies
+ when matching an headline.
+ (org-export--dispatch-ui): Display a help message in header line
+ for scrolling dispatcher's buffer
+ (org-export-resolve-radio-link): Radio targets are
+ case-insensitive.
+
+ * ox-icalendar.el (org-export-icalendar): Fix docstring.
+
+ * ox.el (org-export-dispatch): Fix docstring.
+ (org-export--dispatch-action): Small improvement to line by line
+ scrolling.
+ (org-export-resolve-fuzzy-link): Refactor. Whitespaces are not
+ significant when matching a fuzzy link.
+
+ * org-element.el (org-element-link-parser): Do not remove newlines
+ characters in paths anymore, since this is not required.
+
+ * ox.el (org-export--dispatch-ui): Renamed from
+ `org-export-dispatch-ui'. Handle scrolling.
+ (org-export--dispatch-action): Renamed from
+ `org-export-dispatch-action'. Implement scrolling.
+ (org-export-dispatch): Apply renaming.
+
+ * org.el (org-ctrl-c-ctrl-c): Do nothing when at a blank line,
+ but still run `org-ctrl-c-ctrl-c-final-hook'.
+ (org-end-of-line): Remove `ignore-error'.
+
+ * org-element.el (org-element-at-point): Return nil when in the
+ first empty lines of the buffer. Return headline when in empty
+ lines just after the headline.
+
+ * ox.el (org-export-output-file-name): Add a protection when
+ output file name is the same as the original org.
+
+ * ox-beamer.el (org-beamer-template): Add missing `class' argument
+ for `format-string'.
+
+ * ox-latex.el (org-latex-template): Add missing `class' argument
+ for `format-string'.
+
+ * ox.el (org-export-stack-mode): Fix docstring.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option): Allow
+ completion for ATTR_ prefixed keywords.
+
+ * org.el (org-options-keywords): Add missing colons.
+
+ * org-macs.el (org-default-options): Removed function.
+
+ * org-pcomplete.el (org-command-at-point): Fix bug with some file
+ options.
+ (pcomplete/org-mode/file-option/x): Removed macro.
+ (pcomplete/org-mode/file-option): Refactor code.
+ (pcomplete/org-mode/file-option/author)
+ (pcomplete/org-mode/file-option/date)
+ (pcomplete/org-mode/file-option/title)
+ (pcomplete/org-mode/file-option/tags)
+ (pcomplete/org-mode/file-option/select_tags)
+ (pcomplete/org-mode/file-option/priorities)
+ (pcomplete/org-mode/file-option/language)
+ (pcomplete/org-mode/file-option/filetags)
+ (pcomplete/org-mode/file-option/exclude_tags)
+ (pcomplete/org-mode/file-option/email): New functions.
+
+ * ox.el (org-export--collect-headline-numbering): Remove footnote
+ section from TOC.
+ (org-export-collect-headlines): Do not count footnote section when
+ numbering a headline.
+
+ * ox-beamer.el (org-beamer-plain-list): Also read #+attr_latex
+ attributes in order to determine list's options.
+
+ * ox-ascii.el (org-ascii-inner-template): New function.
+ (org-ascii-template): Use new function.
+ (org-ascii-export-as-ascii, org-ascii-export-to-ascii): Update
+ docstring.
+
+ * org-element.el (org-element-link-parser): Take into
+ consideration links filled and indented.
+
+ * org-element.el (org-element-link-parser): Remove all newline
+ characters in path property.
+
+ * ox.el (org-export-as): Call `inner-template' function, if
+ available.
+
+ * ox-html.el (org-html-inner-template): New function.
+ (org-html-template): Move all parts that should be inserted even
+ in a body-only export into `org-html-inner-template'.
+
+ * org.el (org-forward-element, org-backward-element): When no
+ headline is found at the same level, still move forward or
+ backward.
+
+ * org-element.el (org-element--current-element): Add a limit
+ argument.
+ (org-element--collect-affiliated-keywords): Fix parsing of orphaned
+ keyword at the end of an element.
+
+ * ox-texinfo.el (org-texinfo-src-block): Remove spurious newline
+ character as `org-export-format-code-default' already makes sure
+ the string returned will end with a single one.
+
+ * ox-latex.el (org-latex-headline): When a function returns a
+ sectionning command, only one placeholder should be required.
+
+ * org-element.el (org-element-nested-p): Do not inline function.
+
+ * ox.el (org-export-copy-buffer, org-export-with-buffer-copy)
+ (org-export--generate-copy-script): Moved earlier in the file.
+
+ * ox-texinfo.el (org-texinfo-link): Do not transform path part of
+ internal links.
+
+ * org.el (org-org-menu): Small refactoring.
+
+ * ox-beamer.el (require):
+ * ox-icalendar.el (require):
+ * ox-jsinfo.el (require):
+ * ox-md.el (require): Require cl when compiling.
+
+ * org.el (org-export-backends):
+ * ox.el (org-export-dispatch): Fix docstring.
+
+ * ox.el (org-export-dispatch-ui): Widen UI by 2 characters.
+
+ * ox-latex.el (org-latex-special-block): Add :options attribute to
+ special blocks to specify options.
+
+ * ox-beamer.el (org-beamer-template): Add BEAMER_HEADER keywords
+ below LATEX_HEADER.
+
+ * ox-latex.el (org-latex-format-headline-function): Fix missing
+ parens in the docstring.
+
+ * org.el (org-export-backends): Remove `:initialize' function.
+
+ * org.el (org-reload): Also reload export back-ends in use.
+
+ * ox-latex.el (org-latex-example-block, org-latex-src-block):
+ Ignore element if it's empty. This fixes error "apply: Wrong
+ number of arguments: max, 0".
+
+ * ox-beamer.el (org-beamer-template): Provide an error when LaTeX
+ class is invalid.
+
+ * ox-latex.el (org-latex-template): Provide an error when LaTeX
+ class is invalid.
+
+ * org.el (org-modules): Remove export back-ends from the list.
+ Update docstring.
+ (org-export-backends): New variable.
+
+ * ox.el (org-export-async-start): Make sure export framework is
+ required in the external process.
+
+ * org.el (org-format-latex-header-extra, org-export-have-math):
+ Removed variables.
+ (org-latex-default-packages-alist): Renamed from
+ `org-export-latex-default-packages-alist'.
+ (org-latex-packages-alist): Renamed from
+ `org-export-latex-packages-alist'.
+ (org-try-cdlatex-tab, org-cdlatex-underscore-caret,
+ org-cdlatex-math-modify): Reorder in file.
+ (org-format-latex): Remove `org-format-latex-header-extra'.
+ (org-create-formula-image-with-dvipng,
+ org-create-formula-image-with-imagemagick): Apply variables renaming
+ and removal.
+
+ * org-entities.el (org-entities-user): Update docstring.
+
+ * ox-latex.el (org-latex-classes, org-latex-listings): Update
+ docstring.
+ (org-latex-guess-inputenc): Renamed from `org-latex--guess-inputenc'.
+ (org-latex-guess-babel-language): Renamed from
+ `org-latex--guess-babel-language'.
+ (org-latex-template): Apply renaming.
+
+ * ox-beamer.el (org-beamer-template): Apply renaming.
+
+ * ob-latex.el (org-babel-execute:latex): Apply variable renaming
+ and removal.
+ (org-babel-latex-tex-to-pdf): Call `org-latex-compile' instead of
+ copying it.
+
+ * org-macs.el (org-if-unprotected, org-if-unprotected-1)
+ (org-if-unprotected-at): Removed macros.
+ (org-re-search-forward-unprotected): Removed function.
+
+ * org.el (org-format-latex):
+ * org-list.el (org-list-struct):
+ * org-footnote.el (org-footnote-at-reference-p):
+ * org-capture.el (org-capture-fill-template): Remove reference to
+ `org-protected'.
+
+ * ob-exp.el (org-babel-exp-process-buffer): Renamed from
+ `org-export-blocks-preprocess'.
+
+ * ox.el (org-export-execute-babel-code): Apply previous renaming.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option): Collect valid
+ keywords for completion without requiring the whole export
+ framework.
+ (pcomplete/org-mode/file-option/options): Rewrite using new export
+ framework. Only complete up to the colon.
+ (pcomplete/org-mode/file-option/x): Removed macro.
+ (pcomplete/org-mode/file-option/title)
+ (pcomplete/org-mode/file-option/author)
+ (pcomplete/org-mode/file-option/email)
+ (pcomplete/org-mode/file-option/date): Removed functions.
+ (pcomplete/org-mode/file-option/infojs_opt): New function.
+
+ * org-clock.el (org-clocktable-defaults)
+ (org-clocktable-write-default): Avoid requiring the whole export
+ framework just to check one variable.
+
+ * org-footnote.el (org-footnote-section): Update docstring.
+ (org-footnote-normalize): Remove all export related part from the
+ function.
+
+ * org-inlinetask.el (org-inlinetask-export)
+ (org-inlinetask-export-templates): Removed variables.
+ (org-inlinetask-export-handler): Removed function.
+
+ * org-plot.el: Remove dependency on `org-exp' library.
+
+ * org.el (org-additional-option-like-keywords): Remove variable.
+ (org-get-export-keywords): New function.
+ (org-options-keywords): Update default list of keywords.
+ (org-remove-flyspell-overlays-in): Apply changes to keywords
+ compilation.
+ (org-highlight-latex-fragments-and-specials)
+ (org-latex-and-specials-regexp)
+ (org-export-html-special-string-regexps): Remove variables.
+ (org-compute-latex-and-specials-regexp)
+ (org-do-latex-and-special-faces, org-remove-file-link-modifiers):
+ Remove functions.
+ (org-set-regexps-and-options, org-set-font-lock-defaults): Apply all
+ removals.
+ (org-use-sub-superscripts): Fix docstring. Remove unused group.
+ (org-match-sexp-depth): Make it a defconst instead of a defcustom
+ in order to remove `org-export-translation' group completely.
+
+ * ob-haskell.el (org-babel-haskell-export-to-lhs): Use new
+ exporter.
+
+ * ob-latex.el (org-babel-execute:latex): Use new exporter.
+
+ * ob-org.el (org-babel-execute:org): Use new exporter.
+
+ * org-agenda.el (org-agenda-menu, org-agenda-write): Use new
+ iCalendar export back-end.
+
+ * org-table.el (org-table-export, orgtbl-export): Remove
+ dependency on `org-exp' library.
+ (org-table-clean-before-export): New function.
+ (org-table-colgroup-info): New variable.
+ (orgtbl-to-html): Use to new HTML export back-end.
+
+ * org.el (org-modules): Remove modules relative to obsolete export
+ framework and add those relative to the new one.
+ (org-create-formula-image-with-dvipng, org-format-latex
+ org-create-formula-image-with-imagemagick): Use new exporter.
+ (org-indent-line): INCLUDE keywords are indented like regular
+ keywords.
+ (org-mode-map): Bind C-c C-e to new export dispatcher.
+ (org-menu): Install new exporter in menu.
+
+ * org-ascii.el:
+ * org-beamer.el:
+ * org-docbook.el:
+ * org-exp-blocks.el:
+ * org-exp.el:
+ * org-freemind.el:
+ * org-html.el:
+ * org-icalendar.el:
+ * org-jsinfo.el:
+ * org-latex.el:
+ * org-lparse.el:
+ * org-odt.el:
+ * org-publish.el:
+ * org-special-blocks.el:
+ * org-taskjuggler.el:
+ * org-xoxo.el: Remove
+
+ * ox-ascii.el:
+ * ox-beamer.el:
+ * ox-html.el:
+ * ox-icalendar.el:
+ * ox-jsinfo.el:
+ * ox-latex.el:
+ * ox-man.el:
+ * ox-md.el:
+ * ox-odt.el:
+ * ox-publish.el:
+ * ox-texinfo.el:
+ * ox.el: New file.
+
+ * ob-exp.el (org-export-blocks-preprocess): Do not use
+ `indent-code-rigidly' as it doesn't indent contents of strings.
+
+ * org-element.el (org-element-map): Change to function
+ indentation. Also complete docstring.
+
+ * org.el (org-ctrl-c-ctrl-c): Major rewrite function using
+ Elements.
+
+ * org-element.el (org-element-at-point): When point is before any
+ element, in the first blank lines of the buffer, return nil. When
+ point is within blank lines just after a headline, return that
+ headline.
+ (org-element-context): Return nil when point is within the blank at
+ the beginning of the buffer.
+
+ * org.el (org-edit-special): Fix regression.
+ (org-timestamp-has-time-p, org-timestamp-format)
+ (org-timestamp-split-range, org-timestamp-translate): New
+ functions.
+
+ * org-element.el (org-element-timestamp-interpreter): Interpret
+ timestamps ranges with repeaters.
+
+ * org.el (org-edit-special): Rewrite `org-edit-special' using Org
+ Elements tools. Behaviour should be unchanged.
+
+ * org-element.el (org-element-context): Add an optional argument
+ so that (org-element-context) and (org-element-context
+ (org-element-at-point)) are equivalent.
+
+ * ob.el: Only use the :wrap argument up to the first space when
+ creating the #+END_ directive.
+
+ * org-element.el (org-element-object-variables): New variable.
+ (org-element-parse-secondary-string): Copy some buffer-local
+ variables to the temporary buffer created to parse the string so
+ links can still be properly expanded.
+ (org-element-link-parser): Link expansion and translation are applied
+ transparently for the parser.
+
+ * org-element.el (org-element-line-break-parser): Line break
+ includes the newline character following the backslashes.
+ (org-element-line-break-interpreter): Apply changes to line break
+ parsing.
+
+ * org.el (org-all-targets): Fix radio targets detection when
+ object is directly followed by a non-whitespace character.
+
+ * ob.el (org-babel-use-quick-and-dirty-noweb-expansion): Renamed
+ from `org-babel-use-quick-and-dirty-noweb-expansion'.
+ (org-babel-expand-noweb-references): Use new variable name.
+
+ * org-element.el (org-element-timestamp-interpreter): Fix
+ timestamp interpreter when raw value isn't available.
+
+ * ob-exp.el (org-babel-exp-non-block-elements): Make sure to parse
+ inline babel call or inline src block instead of the following
+ object.
+
+ * org-element.el (org-element-timestamp-parser): Timestamp with
+ time range has active/inactive-range type.
+ (org-element-block-name-alist): Do not reset
+ `org-element-block-name-alist' at each reload.
+ (org-element-object-restrictions): Allow timestamps in parsed
+ keywords (i.e. DATE).
+
+ * org-agenda.el (org-agenda-show-clocking-issues)
+ (org-agenda-format-item): Silence byte compiler.
+
+ * org-colview-xemacs.el (org-agenda-columns): Silence byte
+ compiler.
+
+ * org-colview.el (org-agenda-columns): Silence byte compiler.
+
+ * org.el (org-properties-postprocess-alist): Silence byte
+ compiler.
+
+ * org-element.el (org-element-timestamp-parser): Return nil for
+ unspecified :hour-end and :minute-end properties.
+ (org-element-object-restrictions): Add footnote references objects
+ in table cells.
+ (org-element-interpret-data): Clear text properties when
+ interpreting a string .
+
+ * org-capture.el (org-capture--expand-keyword-in-embedded-elisp):
+ Fix docstring.
+
+ * org.el (org-adaptive-fill-function): Items do not have
+ a :post-affiliated property. Use :begin property instead.
+
+ * org-element.el (org-element-headline-parser)
+ (org-element-inlinetask-parser): Remove :clockedp property.
+
+ * org.el (org-adaptive-fill-function): All elements do not have a
+ :post-affiliated property.
+ (org-macro-replace-all): Signal an error when a circular macro
+ expansion happens.
+ (org-macro-initialize-templates): Fix docstring.
+
+ * org-element.el (org-element-map): Fix docstring.
+ (org-element-contents, org-element-set-contents)
+ (org-element-adopt-elements): Fix accessors and setters wrt
+ secondary strings.
+ (org-element-headline-parser)
+ (org-element-inlinetask-parser): Fix void-function
+ `org-clocking-buffer' error.
+ (org-element-context): Fix org-element-context on parsed keywords.
+ (org-element-context): Find objects in document and parsable
+ affiliated keywords.
+ (org-element-center-block-parser)
+ (org-element-drawer-parser, org-element-dynamic-block-parser)
+ (org-element-footnote-definition-parser)
+ (org-element-plain-list-parser)
+ (org-element-property-drawer-parser)
+ (org-element-quote-block-parser, org-element-special-block-parser)
+ (org-element-babel-call-parser, org-element-comment-parser)
+ (org-element-comment-block-parser, org-element-diary-sexp-parser)
+ (org-element-example-block-parser)
+ (org-element-export-block-parser, org-element-fixed-width-parser)
+ (org-element-horizontal-rule-parser, org-element-keyword-parser)
+ (org-element-latex-environment-parser)
+ (org-element-paragraph-parser, org-element-src-block-parser)
+ (org-element-table-parser, org-element-verse-block-parser): Add
+ `:post-affiliated' property to elements.
+ (org-element-inlinetask-parser): Remove affilated keywords.
+
+ * org.el (org-adaptive-fill-function): Use new property.
+
+ * org-element.el (org-element--collect-affiliated-keywords):
+ Allow duals keywords with only secondary value.
+ (org-element-timestamp-parser): Modify timestamp objects
+ properties.
+ (org-element-headline-parser, org-element-inlinetask-parser): Remove
+ `:timestamp' and `:clock' property. Add `:clockedp' property. Also,
+ set `:closed', `:deadline' and `:scheduled' values to timestamp
+ objects, not strings. Small refactoring.
+ (org-element-clock-parser): Rename `:time' property into `:duration'.
+ Also, set `:value' value as a timestamp object, not a string.
+ (org-element-planning-parser): Set `:closed', `:deadline' and
+ `:scheduled' values to timestamp objects, not strings.
+ (org-element-clock-interpreter, org-element-planning-interpreter)
+ (org-element-timestamp-interpreter): Update interpreters.
+ (org-element--current-element): Tiny refactoring.
+
+ * ob.el (org-babel-where-is-src-block-result): Insert new results
+ keyword in current narrowed part of buffer, if necessary. Small
+ refactoring.
+ (org-babel-insert-result): Do not widen buffer when new results have
+ to be inserted. Therefore, results inserted after the last block of
+ a narrowed buffer still belong to the narrowed part of the buffer.
+
+ * org-agenda.el (org-agenda-get-deadlines): Tiny stylistic change.
+
+ * org-element.el (org-element-paragraph-separate): Diary-sexp
+ elements can separate paragraphs.
+ (org-element-all-elements): Install new `diary-sexp' type.
+ (org-element--current-element): Recognize new `diary-sexp' elements.
+ (org-element-diary-sexp-parser)
+ (org-element-diary-sexp-interpreter): New functions.
+ (org-element-horizontal-rule-parser)
+ (org-element-keyword-parser, org-element--current-element): Small
+ refactoring.
+ (org-element-property): Access to text properties when argument is
+ a string.
+ (org-element-put-property): Correctly set property when target is
+ a string.
+ (org-element-adopt-elements): Also put :parent properties on
+ strings.
+
+ * ob-exp.el (org-babel-exp-code): Escape code when re-creating a
+ src blocks.
+ (org-export-blocks-preprocess): Pos can sometimes be set to a
+ value greater than start, because of indentation, and lead to a
+ search bound error.
+ (org-babel-exp-code): Remove comma-escaping special rule for Org
+ blocks.
+ (org-export-blocks-preprocess): Results of an evaluated code block
+ can be inserted within the blank lines after the block. Hence, if
+ the block has to be removed, delete everything down to the first
+ non-blank line after the end of block closing string, instead of
+ removing everything down to the very end of the block.
+
+ * org.el (org-all-targets): Make sure the regexp really matched a
+ radio target.
+ (org-macro-expand, org-macro-replace-all): Change signature. The
+ function now accepts an alist of templates so it doesn't have to
+ rely only on `org-macro-templates'.
+ (org-macro-initialize-templates): {{{date}}} is not anymore an
+ alias for {{{time}}}. During export, it will provide the value
+ stored in DATE keyword instead.
+
+ * org-element.el (org-element-object-restrictions): Allow links in
+ caption. Also allow inline-src-blocks and inline-babel-calls.
+ (org-element-map): Change signature.
+ (org-element-parsed-keywords): Remove document properties from the
+ value.
+ (org-element-dual-keywords): Fix docstring.
+ (org-element-document-properties): New variable
+ (org-element-all-elements): Add `node-property' as a new element
+ type.
+ (org-element-greater-elements): Add property-drawer element to
+ greater elements since they now contain node-property elements.
+ (org-element-drawer-parser): Small refactoring.
+ (org-element-property-drawer-parser): Move into Greater Elements
+ file section.
+ (org-element-node-property-parser,
+ org-element-node-property-interpreter): New functions.
+ (org-element--current-element, org-element-at-point)
+ (org-element--parse-elements): Handle new element type.
+ (org-element--collect-affiliated-keywords): Fix return value.
+ (org-element-center-block-parser)
+ (org-element-drawer-parser, org-element-dynamic-block-parser)
+ (org-element-footnote-definition-parser)
+ (org-element-plain-list-parser, org-element-quote-block-parser)
+ (org-element-special-block-parser, org-element-babel-call-parser)
+ (org-element-comment-parser, org-element-comment-block-parser)
+ (org-element-example-block-parser)
+ (org-element-export-block-parser, org-element-fixed-width-parser)
+ (org-element-horizontal-rule-parser, org-element-keyword-parser)
+ (org-element-latex-environment-parser)
+ (org-element-paragraph-parser, org-element-property-drawer-parser)
+ (org-element-src-block-parser, org-element-table-parser)
+ (org-element-verse-block-parser): Change signature. Now use an
+ additional argument: affiliated.
+ (org-element--current-element): Skip affiliated keywords and pass
+ them as an argument to parsers. It prevents to walk through these
+ keywords twice: the first time to get to the first line of the
+ element, and a second time to collect the affiliated keywords.
+
+ * ob-exp.el (org-babel-exp-non-block-elements): More accurate
+ white space handling when evaluating inline-src-block, babel-call
+ and inline-babel-call elements or objects. Also removed use of
+ `org-babel-examplize-region' since it would never be called
+ anyway; return value from `org-babel-exp-do-export' is never nil.
+ (org-export-blocks-preprocess): Preserve affiliated keywords when
+ replacing a code block.
+
+ * org-element.el (org-element-multiple-keywords): Allow multiple
+ caption keywords.
+
+ * ob-exp.el (org-export-blocks-preprocess): Fix block evaluation
+ when results are before the block.
+ (org-export-blocks-preprocess): Improve blank lines handling in
+ function. Add comments. Remove `org-export-blocks-postblock-hook'
+ since it's defined nowhere now
+ (and doesn't need to, there's `org-export-before-parsing-hook'
+ already).
+
+ * org-exp-blocks.el: Delete.
+
+ * ob-exp.el (org-export-blocks-preprocess):
+ * ob-ditaa.el (org-ditaa-jar-path): Moved from
+ "org-export-blocks.el".
+
+ * ob-exp.el (org-babel-exp-src-block): Remove unused argument.
+ (org-babel-exp-non-block-elements): Rewrite function using Org
+ Element.
+
+ * org-exp-blocks.el (org-export-blocks-preprocess): Rewrite
+ function using Org Element.
+
+ * org-element.el (org-element-recursive-objects)
+ (org-element-object-restrictions): Remove `macro' from recursive
+ object types.
+
+ * org.el (org-macro-initialize-templates): Small refactoring.
+ (org-mode): Initialize macros templates.
+ (org-macro-templates): New variable.
+ (org-macro-expand, org-macro-replace-all)
+ (org-macro-initialize-templates): New functions.
+
+ * org-element.el (org-element-link-type-is-file): New variable.
+ (org-element-link-parser): Extract search option and application
+ in "file"-type links.
+
+ * org.el (org-mode): Set back comment-start-skip so comment-dwin
+ can tell a keyword from a comment.
+
+2013-11-12 Nicolas Richard <[email protected]>
+
+ * org.el (org-time-stamp): When INACTIVE is non-nil, insert an
+ inactive timestamp also with double universal argument.
+ (org-set-regexps-and-options): Don't set font-lock defaults here.
+ (org-mode): Set font-lock defaults here.
+ (org-insert-link): Call `org-link-try-special-completion' from the
+ original buffer.
+
+2013-11-12 Oleh <[email protected]>
+
+ * org.el (org-open-at-point): The new code is being run in the
+ same spot as `org-open-link-functions'. In case they failed,
+ check if link matches "^id:" and if so, load the id interface and
+ follwo the link.
+
+2013-11-12 Rasmus <[email protected]> (tiny change)
+
+ * ox-latex.el (org-latex--inline-image): The pgf format is
+ associated to an inline image and treated like tikz files.
+
+2013-11-12 Richard Lawrence <[email protected]> (tiny change)
+
+ * org-agenda.el (org-cmp-ts): Avoid error when trying to
+ `string-match' against nil.
+
+2013-11-12 Rick Frankel <[email protected]>
+
+ * ox-html.el (org-html-doctype): New function.
+ (org-html-template): Use `org-html-doctype' instead of inline
+ code.
+ (org-html-headline): Use the new
+ `org-html--container' function to set container element.
+ (org-html--container): Returns appropriate element for headline
+ container.
+ (org-html-divs): Extra character in doc string.
+ (org-babel-execute:sql): Unquote cmdline argument in
+ format string, dbish requires three separate arguments. Add dbi to
+ the list of engines with automatically added header separator.
+ (org-html--build-pre/postamble): Add css class to wrapper div
+ (defaults to `org-pre/postamble-class'). Move spec building to
+ separate function (`org-html-format-spec').
+ (org-html-format-spec): New function.
+ (org-pre/postamble-class): New variable.
+ (org-html--timestamp-format): New variable used in the metadata
+ and the pre/postamble.
+ (org-html-style-default): Make the preamble and postamble use the
+ same style. Make all anchors font-size %100. Remove margin from
+ the content section.
+ (org-html-container-element): Fix docstring.
+ (org-html-postamble-format, org-html-preamble-format): Update
+ docstrings.
+ (org-html-template): Use `org-html--build-pre/postamble'.
+ (org-html--build-pre/postamble): New function, combining the
+ pre/postamble generator. Merge lists of formatters from the
+ preamble and postamble. Fix bug, using :time-stamp-file instead
+ of :with-date for auto display of date: this brings usage in-line
+ with the latex and beamer exporter.
+ (org-html--build-postamble, org-html--build-postamble): Delete.
+ (define-backend): Add :html-doctype and :html-container
+ parameters.
+ (org-html-doctype): New option for doctype declaration.
+ (org-html-container-elemnt): New option for specifying the wrapper
+ container element.
+ (org-html-divs): Change to alist of three entries each containing
+ a key ('preamble, 'content, 'postamble), an HTML element type and
+ an id to allow setting container elements.
+ (org-html--build-preamble, org-html--build-postamble): Modified to
+ use `org-html-divs'.
+ (org-html-template): Modified to use doctype and container-element
+ settings.
+ (org-export-define-backend): Add css url option.
+ (org-export-htmlized-org-css-url): Modify docstring and options.
+ (org-html--build-style): Include css-url if specified.
+
+2013-11-12 Roberto Huelga Díaz <[email protected]> (tiny change)
+
+ * org-timer.el (org-timer-set-timer): Use the variable
+ `org-clock-sound' when calling `org-notify'.
+
+2013-11-12 Ryo TAKAISHI <[email protected]>
+
+ * org-capture.el (org-capture--expand-keyword-in-embedded-elisp):
+ New function.
+ (org-capture-expand-embedded-elisp): Use the new function.
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks): Change argument
+ name collid `org-babel-map-src-blocks' variable 'lang'.
+
+ * org-protocol.el (org-protocol-convert-query-to-plist): New
+ function.
+ (org-protocol-do-capture): Use new function.
+ (org-protocol-data-separator): Change default separator.
+
+2013-11-12 Rémi Vanicat <[email protected]> (tiny change)
+
+ * org-table.el (orgtbl-format-line): Fix bug when formatting line.
+
+2013-11-12 Rüdiger Sonderfeld <[email protected]>
+
+ * ox-latex.el (org-latex-listings): Don't quote const value.
+
+ * ob-C.el (org-babel-C-var-to-C): Add list support
+ (org-babel-C-val-to-C-list-type, org-babel-C-val-to-C-type)
+ (org-babel-C-format-val): New functions.
+ (org-babel-C-ensure-main-wrap, org-babel-execute:C)
+ (org-babel-execute:C++, rg-babel-execute:cpp)
+ (org-babel-C++-compiler, org-babel-C-compiler): Improve docstring.
+
+ * org-entities.el (org-entities): Add support for hbar.
+
+2013-11-12 Sacha Chua <[email protected]> (tiny change)
+
+ * org.el (org-read-date-get-relative): Handle positive and
+ negative weekday specifications so that they don't return today.
+ If today is Friday, "fri" should mean next Friday. This changes
+ the previous behavior, which required you to specify "+2fri" in
+ order to mean next Friday if today was Friday. If you want to
+ schedule something for today, you can use ".".
+
+2013-11-12 Samuel Loury <[email protected]> (tiny change)
+
+ * org.el (org-open-at-point): Open a plain link even if the cursor
+ is before it, which is consistent with the behavior with respect
+ to bracket and angle links.
+
+2013-11-12 Sean O'Halpin <[email protected]> (tiny change)
+
+ * ob.el (org-babel-expand-noweb-references): Capture current noweb
+ start and end patterns then use them to set buffer locals in a
+ (with-temp-buffer ...) form.
+
+2013-11-12 Sebastien Vauban <[email protected]>
+
+ * ox-latex.el (org-latex-listings-langs): Update custom variable.
+
+ * ob-core.el (org-babel-parse-src-block-match): Fix order of list
+ of header arguments.
+
+ * org-clock.el (org-clock-goto-before-context): New option.
+ (org-clock-goto): Use the new option.
+ (org-clocktable-write-default): Insert the summary as a standard
+ #+CAPTION keyword for the (clock) table.
+
+2013-11-12 Stephen Eglen <[email protected]> (tiny change)
+
+ * org-agenda.el (org-agenda-prefix-format): Small docstring
+ enhancement.
+
+2013-11-12 Suhail Shergill <[email protected]> (tiny change)
+
+ * ob-core.el (org-babel-temp-file): For remote hosts, modify the
+ prefix and leave `temporary-file-directory' unchanged.
+
+2013-11-12 Suvayu Ali <[email protected]> (tiny change)
+
+ * org.el (org-speed-commands-default): Change default binding for
+ org-mark-subtree from "." to "@" to be more consistent with "C-c
+ @".
+
+2013-11-12 Tim Burt <[email protected]> (tiny change)
+
+ * org-datetree.el (org-datetree-find-year-create): Also match
+ headlines with tags.
+
+2013-11-12 Toby S. Cubitt <[email protected]>
+
+ * org.el (org-time-clocksum-format)
+ (org-time-clocksum-fractional-format): In addition to a single
+ format string, the clocksum formats can now be plists specifying
+ separate formats for different time units.
+ (org-minutes-to-clocksum-string): New function to replace
+ `org-minutes-to-hh:mm-string', which converts a number of minutes
+ to a string according to the customization options.
+
+ * org-colview.el (org-columns-number-to-string): Use the new
+ `org-minutes-to-clocksum-string' function to format clocksum
+ durations.
+
+ * org-clock.el: Always call new `org-minutes-to-clocksum-string'
+ function when formatting time durations, instead of calling
+ `org-minutes-to-hh:mm-string' or passing
+ `org-time-clocksum-format' directly to format.
+
+2013-11-12 Tokuya Kameshima <[email protected]>
+
+ * org-mew.el (org-mew-inbox-folder, org-mew-use-id-db)
+ (org-mew-subject-alist, org-mew-capture-inbox-folders)
+ (org-mew-capture-guess-alist): New options.
+ (org-mew-store-link, org-mew-open): Rewrite.
+ (org-mew-folder-name, org-mew-follow-link)
+ (org-mew-folder-eixsts-p, org-mew-get-msgnum)
+ (org-mew-open-by-message-id, org-mew-search, org-mew-capture)
+ (org-mew-capture-guess-selection-keys): New functions.
+
+2013-11-12 Trevor Murphy <[email protected]> (tiny change)
+
+ * org.el (org-get-compact-tod): Always pad minutes to two places.
+
+2013-11-12 Viktor Rosenfeld <[email protected]> (tiny change)
+
+ * org.el (org-agenda-prepare-buffers): Add tags defined in
+ `org-tag-persistent-alist' to `org-tag-alist-for-agenda'.
+
+2013-11-12 Vitalie Spinu <[email protected]>
+
+ * ob-tangle.el (org-babel-find-file-noselect-refresh): Call
+ `find-file-noselect' with 'nowarn argument to surpress
+ `yes-or-no-p' reversion message.
+
+ * ob-core.el (org-babel-where-is-src-block-head): Return
+ `point-marker' instead of `point'.
+
+2013-11-12 William Waites <[email protected]>
+
+ * ob-abc.el: New file.
+
+2013-11-12 Yann Hodique <[email protected]>
+
+ * org-publish.el (org-publish-org-to-taskjuggler): New function to
+ publish taskjuggler projects.
+
+ * org-taskjuggler.el (org-export-as-taskjuggler): Adapt signature
+ to reflect standard interface, in particular allow export to
+ buffer.
+ (org-export-taskjuggler-report-tag): New option.
+ (org-export-taskjuggler-valid-report-attributes): New option.
+ (org-export-as-taskjuggler): Compute reports.
+ (org-taskjuggler-open-report): Generate report from org item.
+ (org-taskjuggler-insert-reports): Insert default reports only if no
+ explicit one is defined.
+ (org-export-taskjuggler-keep-project-as-task): New option.
+ (org-export-as-taskjuggler): Optionally drop the topmost "task".
+ (org-taskjuggler-assign-task-ids): Adapt path computation by
+ optionally dropping the topmost component.
+ (org-taskjuggler-open-project): Use START - END as an alternative
+ to START +Xd.
+ (org-export-taskjuggler-default-global-header): New option.
+ (org-export-as-taskjuggler): Insert global header before anything
+ else.
+ (org-taskjuggler-open-task): Task with end-only is also a
+ milestone (deadline), task with length is not.
+ (org-taskjuggler-date): Introduce new function to produce a
+ taskjuggler-compatible date.
+ (org-taskjuggler-components): Make use of SCHEDULED/DEADLINE
+ properties.
+ (org-export-as-taskjuggler): Compute opt-plist, use
+ `org-install-letbind'.
+ (org-export-taskjuggler-valid-task-attributes)
+ (org-export-taskjuggler-valid-resource-attributes): New options.
+
+2013-11-12 Yasushi Shoji <[email protected]>
+
+ * org-clock.el (org-clock-x11idle-program-name): New option.
+ (org-x11idle-exists-p, org-x11-idle-seconds): Use it.
+
+2013-11-12 Yoshinari Nomura <[email protected]>
+
+ * ox-html.el (org-html--has-caption-p): New function.
+ (org-html-link--inline-image, org-html-table): Prepend ordinal
+ number to caption.
+ (org-html-link): Make numbered link by counting captioned figures
+ and tables.
+
+ * ox.el (org-export-dictionary): Add Japanese translations for
+ figures and tables. Add "Figure %d:" entry in the same manner
+ with "Table %d:".
+
+2013-11-12 Nicolas Richard <[email protected]>
+
+ * ob.el (org-babel-edit-distance): When insertion or deletion are
+ needed, make sure the distance is incremented. In addition, the
+ now obsolete mmin function was removed.
+
+2013-11-12 Oleh Krehel <[email protected]>
+
+ * org-capture.el (org-capture-expand-embedded-elisp): Throw error
+ if result is not a string and not nil. If the result is nil,
+ treat it as if it was the empty string.
+
+ * org-clock.el (org-clock-notify-once-if-expired): Honor
+ `org-clock-sound'.
+
+2013-11-12 Rasmus Pank <[email protected]>
+
+ * org.el (org-format-latex-header): Remove eucal and amsmath.
+ (org-latex-default-packages-alist): Remove amstext and add
+ amsmath.
+
+ * ox-latex.el (org-latex-item): Use square as unchecked symbol.
+
+ * org.el (org-latex-default-packages-alist): Remove latexsym.
+
+ * org-entities.el (org-entities): Add support for ell, imath,
+ jmath, varphi, varpi, aleph, gimel, beth, dalet, cdots, S (§),
+ dag, ddag, colon, therefore, because, triangleq, leq, geq,
+ lessgtr, lesseqgtr, ll, lll, gg, ggg, prec, preceq, preccurleyeq,
+ succ, succeq, succurleyeq, setminus, nexist(s), mho, check, frown,
+ diamond. Changes loz, vert, checkmark, smile and tilde.
+
+ * ob-C.el: Added C++ to `org-babel-load-languages' automatically
+ after loading C.
+
+ * org-src.el (org-src-lang-modes): Added association between
+ language C++ and `c++-mode'.
+
+ * ox.el (org-export-smart-quotes-alist): Added ("da" "no" "nb"
+ "nn" "sv").
+ (org-export-dictionary): Added some entries ("da" "no" "nb" "nn"
+ "sv").
+ (org-export-default-language): Mention other variables affected by
+ language.
+
+ * ox-latex.el (org-latex-babel-language-alist): Added 'nb', 'nn',
+ and 'no' for Norwegian. Removed 'no-no'.
+ (org-latex-pdf-process): let `latexmk' be a preconfigured choice
+ and change the wording of the docstring.
+ (org-latex-guess-babel-language): Replace AUTO with language if
+ AUTO is the option of the LaTeX package Babel.
+ (org-latex-classes): updated documentation with respect
+ to `org-latex-guess-babel-language'.
+
+2013-11-12 Дядов Васил Стоянов <[email protected]> (tiny change)
+
+ * org-docview.el (org-docview-export): New function to export
+ docview links.
+
2013-04-18 Stefan Monnier <[email protected]>
* org-agenda.el (org-agenda-mode):
diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el
index 42a98de8c0..e9eec934dc 100644
--- a/lisp/org/ob-C.el
+++ b/lisp/org/ob-C.el
@@ -31,7 +31,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(require 'cc-mode)
(declare-function org-entry-get "org"
@@ -45,24 +44,24 @@
(defvar org-babel-C-compiler "gcc"
"Command used to compile a C source code file into an
- executable.")
+executable.")
(defvar org-babel-C++-compiler "g++"
"Command used to compile a C++ source code file into an
- executable.")
+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++'."
+ "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'."
+ "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)
@@ -71,8 +70,8 @@ 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'."
+ "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)
@@ -106,11 +105,11 @@ or `org-babel-execute:C++'."
(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-result-cond (cdr (assoc :result-params params))
+ (org-babel-read results)
+ (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-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@@ -147,10 +146,10 @@ it's header arguments."
body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body)
- "Wrap body in a \"main\" function call if none exists."
+ "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)))
+ (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
@@ -164,6 +163,59 @@ support for sessions"
;; helper functions
+(defun org-babel-C-format-val (type val)
+ "Handle the FORMAT part of TYPE with the data from VAL."
+ (let ((format-data (cadr type)))
+ (if (stringp format-data)
+ (cons "" (format format-data val))
+ (funcall format-data val))))
+
+(defun org-babel-C-val-to-C-type (val)
+ "Determine the type of VAL.
+Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type.
+FORMAT can be either a format string or a function which is called with VAL."
+ (cond
+ ((integerp val) '("int" "%d"))
+ ((floatp val) '("double" "%f"))
+ ((or (listp val) (vectorp val))
+ (lexical-let ((type (org-babel-C-val-to-C-list-type val)))
+ (list (car type)
+ (lambda (val)
+ (cons
+ (format "[%d]%s"
+ (length val)
+ (car (org-babel-C-format-val type (elt val 0))))
+ (concat "{ "
+ (mapconcat (lambda (v)
+ (cdr (org-babel-C-format-val type v)))
+ val
+ ", ")
+ " }"))))))
+ (t ;; treat unknown types as string
+ '("char" (lambda (val)
+ (let ((s (format "%s" val))) ;; convert to string for unknown types
+ (cons (format "[%d]" (1+ (length s)))
+ (concat "\"" s "\""))))))))
+
+(defun org-babel-C-val-to-C-list-type (val)
+ "Determine the C array type of a VAL."
+ (let (type)
+ (mapc
+ #'(lambda (i)
+ (let* ((tmp-type (org-babel-C-val-to-C-type i))
+ (type-name (car type))
+ (tmp-type-name (car tmp-type)))
+ (when (and type (not (string= type-name tmp-type-name)))
+ (if (and (member type-name '("int" "double" "int32_t"))
+ (member tmp-type-name '("int" "double" "int32_t")))
+ (setq tmp-type '("double" "" "%f"))
+ (error "Only homogeneous lists are supported by C. You can not mix %s and %s"
+ type-name
+ tmp-type-name)))
+ (setq type tmp-type)))
+ val)
+ type))
+
(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."
@@ -174,22 +226,17 @@ of the same value."
(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)))))
-
+ (let* ((type-data (org-babel-C-val-to-C-type val))
+ (type (car type-data))
+ (formated (org-babel-C-format-val type-data val))
+ (suffix (car formated))
+ (data (cdr formated)))
+ (format "%s %s%s = %s;"
+ type
+ var
+ suffix
+ data))))
(provide 'ob-C)
-
-
;;; ob-C.el ends here
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index 562f37d7b9..74d7513df3 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -28,9 +28,6 @@
;;; 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))
@@ -96,8 +93,13 @@
inside
(list "dev.off()"))
inside))
- (append (org-babel-variable-assignments:R params)
- (list body))) "\n")))
+ (append
+ (when (cdr (assoc :prologue params))
+ (list (cdr (assoc :prologue params))))
+ (org-babel-variable-assignments:R params)
+ (list body)
+ (when (cdr (assoc :epilogue params))
+ (list (cdr (assoc :epilogue params)))))) "\n")))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
@@ -212,6 +214,9 @@ This function is called by `org-babel-execute-src-block'."
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
+ (when (get-buffer session)
+ ;; Session buffer exists, but with dead process
+ (set-buffer session))
(require 'ess) (R)
(rename-buffer
(if (bufferp session)
@@ -234,31 +239,40 @@ current code buffer."
(and (member "graphics" (cdr (assq :result-params params)))
(cdr (assq :file params))))
+(defvar org-babel-R-graphics-devices
+ '((:bmp "bmp" "filename")
+ (:jpg "jpeg" "filename")
+ (:jpeg "jpeg" "filename")
+ (:tikz "tikz" "file")
+ (:tiff "tiff" "filename")
+ (:png "png" "filename")
+ (:svg "svg" "file")
+ (:pdf "pdf" "file")
+ (:ps "postscript" "file")
+ (:postscript "postscript" "file"))
+ "An alist mapping graphics file types to R functions.
+
+Each member of this list is a list with three members:
+1. the file extension of the graphics file, as an elisp :keyword
+2. the R graphics device function to call to generate such a file
+3. the name of the argument to this function which specifies the
+ file to write to (typically \"file\" or \"filename\")")
+
(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"))
+ (let* ((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)))
+ (device-info (or (assq (intern (concat ":" device))
+ org-babel-R-graphics-devices)
+ (assq :png org-babel-R-graphics-devices)))
+ (extra-args (cdr (assq :R-dev-args params))) filearg args)
+ (setq device (nth 1 device-info))
+ (setq filearg (nth 2 device-info))
(setq args (mapconcat
(lambda (pair)
(if (member (car pair) allowed-args)
@@ -302,11 +316,10 @@ last statement in BODY, as elisp."
(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-result-cond 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))))
@@ -335,11 +348,10 @@ last statement in BODY, as elisp."
"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-result-cond 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
diff --git a/lisp/org/ob-abc.el b/lisp/org/ob-abc.el
new file mode 100644
index 0000000000..a980b0225d
--- /dev/null
+++ b/lisp/org/ob-abc.el
@@ -0,0 +1,94 @@
+;;; ob-abc.el --- org-babel functions for template evaluation
+
+;; Copyright (C) Free Software Foundation
+
+;; Author: William Waites
+;; Keywords: literate programming, music
+;; Homepage: http://www.tardis.ed.ac.uk/wwaites
+;; Version: 0.01
+
+;;; 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:
+
+;;; This file adds support to Org Babel for music in ABC notation.
+;;; It requires that the abcm2ps program is installed.
+;;; See http://moinejf.free.fr/
+
+(require 'ob)
+
+;; optionally define a file extension for this language
+(add-to-list 'org-babel-tangle-lang-exts '("abc" . "abc"))
+
+;; optionally declare default header arguments for this language
+(defvar org-babel-default-header-args:abc
+ '((:results . "file") (:exports . "results"))
+ "Default arguments to use when evaluating an ABC source block.")
+
+(defun org-babel-expand-body:abc (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:abc (body params)
+ "Execute a block of ABC code with org-babel. This function is
+ called by `org-babel-execute-src-block'"
+ (message "executing Abc source code block")
+ (let* ((result-params (split-string (or (cdr (assoc :results params)))))
+ (cmdline (cdr (assoc :cmdline params)))
+ (out-file ((lambda (el)
+ (or el
+ (error "abc code block requires :file header argument")))
+ (replace-regexp-in-string "\.pdf$" ".ps" (cdr (assoc :file params)))))
+ (in-file (org-babel-temp-file "abc-"))
+ (render (concat "abcm2ps" " " cmdline
+ " -O " (org-babel-process-file-name out-file)
+ " " (org-babel-process-file-name in-file))))
+ (with-temp-file in-file (insert (org-babel-expand-body:abc body params)))
+ (org-babel-eval render "")
+ ;;; handle where abcm2ps changes the file name (to support multiple files
+ (when (or (string= (file-name-extension out-file) "eps")
+ (string= (file-name-extension out-file) "svg"))
+ (rename-file (concat
+ (file-name-sans-extension out-file) "001."
+ (file-name-extension out-file))
+ out-file t))
+ ;;; if we were asked for a pdf...
+ (when (string= (file-name-extension (cdr (assoc :file params))) "pdf")
+ (org-babel-eval (concat "ps2pdf" " " out-file " " (cdr (assoc :file params))) ""))
+ ;;; indicate that the file has been written
+ nil))
+
+;; This function should be used to assign any variables in params in
+;; the context of the session environment.
+(defun org-babel-prep-session:abc (session params)
+ "Return an error because abc does not support sessions."
+ (error "ABC does not support sessions"))
+
+(provide 'ob-abc)
+;;; ob-abc.el ends here
diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el
index 12d625acf2..373d5fd987 100644
--- a/lisp/org/ob-awk.el
+++ b/lisp/org/ob-awk.el
@@ -32,7 +32,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(require 'org-compat)
(eval-when-compile (require 'cl))
@@ -45,7 +44,7 @@
(defvar org-babel-awk-command "awk"
"Name of the awk executable command.")
-(defun org-babel-expand-body:awk (body params &optional processed-params)
+(defun org-babel-expand-body:awk (body 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
@@ -78,10 +77,8 @@ called by `org-babel-execute-src-block'"
(org-babel-reassemble-table
((lambda (results)
(when results
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params)
- (member "output" result-params))
- results
+ (org-babel-result-cond result-params
+ results
(let ((tmp (org-babel-temp-file "awk-results-")))
(with-temp-file tmp (insert results))
(org-babel-import-elisp-from-file tmp)))))
diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el
index a8e53c01b1..766f6cebb8 100644
--- a/lisp/org/ob-calc.el
+++ b/lisp/org/ob-calc.el
@@ -31,7 +31,6 @@
(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))
diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el
index b020498eb1..bc2bbc0d09 100644
--- a/lisp/org/ob-clojure.el
+++ b/lisp/org/ob-clojure.el
@@ -79,9 +79,8 @@
(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
+ (org-babel-result-cond result-params
+ result
(condition-case nil (org-babel-script-escape result)
(error result)))))
(slime-eval
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index 5ea3be2d5b..8b03e2dcc4 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -30,7 +30,7 @@
;; org-babel at large.
;;; Code:
-(require 'ob)
+(require 'ob-core)
(require 'org-compat)
(require 'comint)
(eval-when-compile (require 'cl))
@@ -117,7 +117,7 @@ or user `keyboard-quit' during execution of 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))
+(def-edebug-spec org-babel-comint-with-output (sexp body))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
new file mode 100644
index 0000000000..cc6b7a93d6
--- /dev/null
+++ b/lisp/org/ob-core.el
@@ -0,0 +1,2778 @@
+;;; ob-core.el --- working with code blocks in org-mode
+
+;; Copyright (C) 2009-2013 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))
+;; dynamically scoped for tramp
+(defvar org-babel-call-process-region-original nil)
+(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 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-split-string "org" (string &optional separators))
+(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-next-block "org" (arg &optional backward block-regexp))
+(declare-function org-previous-block "org" (arg &optional block-regexp))
+(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-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-remove-if "org" (predicate seq))
+(declare-function org-completing-read "org" (&rest args))
+(declare-function org-escape-code-in-region "org-src" (beg end))
+(declare-function org-unescape-code-in-string "org-src" (s))
+(declare-function org-table-to-lisp "org-table" (&optional txt))
+(declare-function org-reverse-string "org" (string))
+(declare-function org-element-context "org-element" (&optional ELEMENT))
+
+(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
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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)
+
+(defcustom org-babel-inline-result-wrap "=%s="
+ "Format string used to wrap inline results.
+This string must include a \"%s\" which will be replaced by the results."
+ :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 block-head)."
+ (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)))))
+ ;; 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 head)))))
+
+(defvar org-current-export-file) ; dynamically bound
+(defmacro org-babel-check-confirm-evaluate (info &rest body)
+ "Evaluate BODY with special execution confirmation variables set.
+
+Specifically; NOEVAL will indicate if evaluation is allowed,
+QUERY will indicate if a user query is required, CODE-BLOCK will
+hold the language of the code block, and BLOCK-NAME will hold the
+name of the code block."
+ (declare (indent defun))
+ (org-with-gensyms
+ (lang block-body headers name eval eval-no export eval-no-export)
+ `(let* ((,lang (nth 0 ,info))
+ (,block-body (nth 1 ,info))
+ (,headers (nth 2 ,info))
+ (,name (nth 4 ,info))
+ (,eval (or (cdr (assoc :eval ,headers))
+ (when (assoc :noeval ,headers) "no")))
+ (,eval-no (or (equal ,eval "no")
+ (equal ,eval "never")))
+ (,export (org-bound-and-true-p org-current-export-file))
+ (,eval-no-export (and ,export (or (equal ,eval "no-export")
+ (equal ,eval "never-export"))))
+ (noeval (or ,eval-no ,eval-no-export))
+ (query (or (equal ,eval "query")
+ (and ,export (equal ,eval "query-export"))
+ (if (functionp org-confirm-babel-evaluate)
+ (funcall org-confirm-babel-evaluate
+ ,lang ,block-body)
+ org-confirm-babel-evaluate)))
+ (code-block (if ,info (format " %s " ,lang) " "))
+ (block-name (if ,name (format " (%s) " ,name) " ")))
+ ,@body)))
+
+(defsubst org-babel-check-evaluate (info)
+ "Check if code block INFO should be evaluated.
+Do not query the user."
+ (org-babel-check-confirm-evaluate info
+ (not (when noeval
+ (message (format "Evaluation of this%scode-block%sis disabled."
+ code-block block-name))))))
+
+ ;; dynamically scoped for asynchroneous export
+(defvar org-babel-confirm-evaluate-answer-no)
+
+(defsubst org-babel-confirm-evaluate (info)
+ "Confirm evaluation of the code block INFO.
+
+If the variable `org-babel-confirm-evaluate-answer-no' is bound
+to a non-nil value, auto-answer with \"no\".
+
+This query can also 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."
+ (org-babel-check-confirm-evaluate info
+ (not (when query
+ (unless
+ (and (not (org-bound-and-true-p
+ org-babel-confirm-evaluate-answer-no))
+ (yes-or-no-p
+ (format "Evaluate this%scode block%son your system? "
+ code-block block-name)))
+ (message (format "Evaluation of this%scode-block%sis aborted."
+ code-block block-name)))))))
+
+;;;###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)))
+
+(defmacro org-babel-when-in-src-block (&rest body)
+ "Execute BODY if point is in a source block and return t.
+
+Otherwise do nothing and return nil."
+ `(if (or (org-babel-where-is-src-block-head)
+ (org-babel-get-inline-src-block-matches))
+ (progn
+ ,@body
+ t)
+ nil))
+
+(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)
+ (org-babel-when-in-src-block
+ (org-babel-eval-wipe-error-buffer)
+ (org-babel-execute-src-block current-prefix-arg)))
+
+;;;###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)
+ (org-babel-when-in-src-block
+ (org-babel-expand-src-block current-prefix-arg)))
+
+;;;###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)
+ (org-babel-when-in-src-block
+ (org-babel-load-in-session current-prefix-arg)))
+
+(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-switch-to-session'."
+ (interactive)
+ (org-babel-when-in-src-block
+ (org-babel-switch-to-session current-prefix-arg)))
+
+(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)))
+ (epilogue . :any)
+ (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)))
+ (post . :any)
+ (prologue . :any)
+ (results . ((file list vector table scalar verbatim)
+ (raw html latex org code pp drawer)
+ (replace silent none append prepend)
+ (output value)))
+ (rownames . ((no yes)))
+ (sep . :any)
+ (session . :any)
+ (shebang . :any)
+ (tangle . ((tangle yes no :any)))
+ (tangle-mode . ((#o755 #o555 #o444 :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"))
+ "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)
+ "\\(\\[\\("
+ ;; FIXME The string below is `org-ts-regexp'
+ "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
+ " \\)?\\([[: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-hash-show-time nil
+ "Non-nil means show the time the code block was evaluated in the result 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)
+(defvar org-babel-current-src-block-location nil
+ "Marker pointing to the src block currently being executed.
+This may also point to a call line or an inline code block. If
+multiple blocks are being executed (e.g., in chained execution
+through use of the :var header argument) this marker points to
+the outer-most code block.")
+
+;;;###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* ((org-babel-current-src-block-location
+ (or org-babel-current-src-block-location
+ (nth 6 info)
+ (org-babel-where-is-src-block-head)))
+ (info (if info
+ (copy-tree info)
+ (org-babel-get-src-block-info)))
+ (merged-params (org-babel-merge-params (nth 2 info) params)))
+ (when (org-babel-check-evaluate
+ (let ((i info)) (setf (nth 2 i) merged-params) i))
+ (let* ((params (if params
+ (org-babel-process-params merged-params)
+ (nth 2 info)))
+ (cachep (and (not arg) (cdr (assoc :cache params))
+ (string= "yes" (cdr (assoc :cache params)))))
+ (new-hash (when cachep (org-babel-sha1-hash info)))
+ (old-hash (when cachep (org-babel-current-result-hash)))
+ (cache-current-p (and (not arg) new-hash
+ (equal new-hash old-hash))))
+ (cond
+ (cache-current-p
+ (save-excursion ;; return cached result
+ (goto-char (org-babel-where-is-src-block-result nil info))
+ (end-of-line 1) (forward-char 1)
+ (let ((result (org-babel-read-result)))
+ (message (replace-regexp-in-string
+ "%" "%%" (format "%S" result))) result)))
+ ((org-babel-confirm-evaluate
+ (let ((i info)) (setf (nth 2 i) merged-params) i))
+ (let* ((lang (nth 0 info))
+ (result-params (cdr (assoc :result-params params)))
+ (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 ;; for tramp handler
+ (or (org-bound-and-true-p
+ org-babel-call-process-region-original)
+ (symbol-function 'call-process-region)))
+ (indent (nth 5 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))))
+ (message "executing %s code block%s..."
+ (capitalize lang)
+ (if (nth 4 info) (format " (%s)" (nth 4 info)) ""))
+ (if (member "none" result-params)
+ (progn
+ (funcall cmd body params)
+ (message "result silenced")
+ (setq result nil))
+ (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))))
+ ;; possibly perform post process provided its appropriate
+ (when (cdr (assoc :post params))
+ (let ((*this* (if (cdr (assoc :file params))
+ (org-babel-result-to-file
+ (cdr (assoc :file params))
+ (when (assoc :file-desc params)
+ (or (cdr (assoc :file-desc params))
+ result)))
+ result)))
+ (setq result (org-babel-ref-resolve
+ (cdr (assoc :post params))))
+ (when (cdr (assoc :file params))
+ (setq result-params
+ (remove "file" result-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."
+ (let ((pro (cdr (assoc :prologue params)))
+ (epi (cdr (assoc :epilogue params))))
+ (mapconcat #'identity
+ (append (when pro (list pro))
+ var-lines
+ (list body)
+ (when epi (list epi)))
+ "\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))))))
+ (if (org-called-interactively-p 'any)
+ (org-edit-src-code
+ nil expanded
+ (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
+ expanded)))
+
+(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))))
+ (setf (aref (aref dist 0) 0) 0)
+ (dolist (j (number-sequence 1 l2))
+ (setf (aref (aref dist 0) j) j))
+ (dolist (i (number-sequence 1 l1))
+ (setf (aref (aref dist i) 0) i)
+ (dolist (j (number-sequence 1 l2))
+ (setf (aref (aref dist i) j)
+ (min
+ (1+ (funcall in (1- i) j))
+ (1+ (funcall in i (1- j)))
+ (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
+ (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
+ (when (boundp lang-headers) (eval lang-headers))))
+ (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 (if (not info)
+ (user-error "No src code block at point")
+ (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)
+
+(defun org-babel-active-location-p ()
+ (memq (car (save-match-data (org-element-context)))
+ '(babel-call inline-babel-call inline-src-block src-block)))
+
+;;;###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 'light)))
+ (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)
+ (when (org-babel-active-location-p)
+ (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)
+ (when (org-babel-active-location-p)
+ (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)
+ (when (org-babel-active-location-p)
+ (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)
+ (when (org-babel-active-location-p)
+ (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" "none"
+ "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 5)))
+
+(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 5))
+ (mapc #'delete-overlay (overlays-at (point)))
+ (forward-char org-babel-hash-show)
+ (mapc #'delete-overlay (overlays-at (point)))
+ (replace-match hash nil nil nil 5)
+ (goto-char (point-at-bol))
+ (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 5))
+ (let* ((start (match-beginning 5))
+ (hide-start (+ org-babel-hash-show start))
+ (end (match-end 5))
+ (hash (match-string 5))
+ 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 (and (not org-babel-hash-show-time)
+ (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 a list of association lists of source block params
+specified in the properties of the current outline entry."
+ (save-match-data
+ (list
+ ;; DEPRECATED header arguments specified as separate property at
+ ;; point of definition
+ (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))))))))))
+ ;; header arguments specified with the header-args property at
+ ;; point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ "header-args" 'inherit))
+ (when lang ;; language-specific header arguments at point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ (concat "header-args:" lang) 'inherit))))))
+
+(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-unescape-code-in-string body))
+ (unless preserve-indentation (org-do-remove-indentation))
+ (buffer-string)))
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (when (boundp lang-headers) (eval lang-headers))
+ (append
+ (org-babel-params-from-properties lang)
+ (list (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-unescape-code-in-string (org-no-properties (match-string 5)))
+ (apply #'org-babel-merge-params
+ org-babel-default-inline-header-args
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (append
+ (org-babel-params-from-properties lang)
+ (list (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
+rownames, and the `cdr' of which contains a list of the rownames.
+Note: this function removes any hlines in TABLE."
+ (let* ((table (org-babel-del-hlines table))
+ (rownames (funcall (lambda ()
+ (let ((tp table))
+ (mapcar
+ (lambda (row)
+ (prog1
+ (pop (car tp))
+ (setq tp (cdr tp))))
+ table))))))
+ (cons table rownames)))
+
+(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-marker))))))
+
+;;;###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)
+ (looking-at org-babel-lob-one-liner-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")
+ (org-next-block arg nil org-babel-src-block-regexp))
+
+;;;###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")
+ (org-previous-block arg org-babel-src-block-regexp))
+
+(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 #'symbol-name
+ (delete-dups
+ (append (mapcar #'car org-babel-load-languages)
+ (mapcar (lambda (el) (intern (car el)))
+ org-src-lang-modes))))))
+ (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 (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))
+ (org-with-wide-buffer
+ (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 5))))
+ (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
+ (catch 'non-comment
+ (while (re-search-forward "[^ \f\t\n\r\v]" nil t)
+ (beginning-of-line 1)
+ (cond
+ ((looking-at (concat org-babel-result-regexp "\n"))
+ (throw 'non-comment t))
+ ((looking-at "^[ \t]*#") (end-of-line 1))
+ (t (throw 'non-comment nil))))))
+ (let ((this-hash (match-string 5)))
+ (prog1 (point)
+ ;; must remove and rebuild if hash!=old-hash
+ (if (and hash (not (string= hash this-hash)))
+ (prog1 nil
+ (forward-line 1)
+ (delete-region
+ end (org-babel-result-end)))
+ (setq end nil)))))))))))
+ (if (not (and insert end)) found
+ (goto-char end)
+ (unless beg
+ (if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
+ (insert (concat
+ (when (wholenump indent) (make-string indent ? ))
+ "#+" org-babel-results-keyword
+ (when hash
+ (if org-babel-hash-show-time
+ (concat
+ "["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "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)))))
+
+(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)))
+ ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$"))
+ (setq result-string
+ (org-babel-trim
+ (mapconcat (lambda (line)
+ (or (and (> (length line) 1)
+ (string-match "^[ \t]*: ?\\(.+\\)" line)
+ (match-string 1 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 into the Org-mode buffer but
+ the results are echoed to the minibuffer and are
+ ingested by Emacs (a potentially time consuming
+ process)
+
+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))))
+ (visible-beg (copy-marker (point-min)))
+ (visible-end (copy-marker (point-max)))
+ ;; When results exist outside of the current visible
+ ;; region of the buffer, be sure to widen buffer to
+ ;; update them.
+ (outside-scope-p (and existing-result
+ (or (> visible-beg existing-result)
+ (<= visible-end existing-result))))
+ 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")))
+ (unwind-protect
+ (progn
+ (when outside-scope-p (widen))
+ (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 no-escape)
+ (goto-char end) (insert (concat finish "\n"))
+ (goto-char beg) (insert (concat start "\n"))
+ (unless no-escape
+ (org-escape-code-in-region (min (point) end) 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 (split-string result "\n" t))))
+ '(: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_" (car (org-split-string 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)
+ (goto-char beg) (if (org-at-table-p) (org-cycle))
+ (funcall wrap "#+BEGIN_SRC org" "#+END_SRC"))
+ ((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))
+ (goto-char beg) (if (org-at-table-p) (org-cycle))
+ (funcall wrap ":RESULTS:" ":END:" 'no-escape))
+ ((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.")))
+ (when outside-scope-p (narrow-to-region visible-beg visible-end))
+ (set-marker visible-beg nil)
+ (set-marker visible-end nil))))))
+
+(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 org-babel-inline-result-wrap
+ (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
+ clearnames)
+
+ (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))
+ (progn
+ (push name clearnames)
+ (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))
+ (let ((name (car (nth variable-index vars))))
+ (push name clearnames) ; clear out colnames
+ ; and rownames
+ ; for replace vars
+ (prog1 (setf (cddr (nth variable-index vars))
+ (concat (symbol-name name) "=" (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)))
+ ;; clear out col-names and row-names for replaced variables
+ (mapc
+ (lambda (name)
+ (mapc
+ (lambda (param)
+ (when (assoc param params)
+ (setf (cdr (assoc param params))
+ (org-remove-if (lambda (pair) (equal (car pair) name))
+ (cdr (assoc param params))))
+ (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param)
+ (null (cdr pair))))
+ params))))
+ (list :colname-names :rowname-names)))
+ clearnames)
+ (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 'light)))
+ (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-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)
+ (or (member (substring cell 0 1) '("(" "'" "`" "["))
+ (string= cell "*this*")))
+ (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]+" string)
+ (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-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-reverse-string
+ (org-babel-chomp (org-reverse-string string) regexp))
+ regexp))
+
+(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."))
+
+(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms)
+ "Call the code to parse raw string results according to RESULT-PARAMS."
+ (declare (indent 1)
+ (debug (form form &rest form)))
+ (org-with-gensyms (params)
+ `(let ((,params ,result-params))
+ (unless (member "none" ,params)
+ (if (or (member "scalar" ,params)
+ (member "verbatim" ,params)
+ (member "html" ,params)
+ (member "code" ,params)
+ (member "pp" ,params)
+ (and (or (member "output" ,params)
+ (member "raw" ,params)
+ (member "org" ,params)
+ (member "drawer" ,params))
+ (not (member "table" ,params))))
+ ,scalar-form
+ ,@table-forms)))))
+(def-edebug-spec org-babel-result-cond (form form body))
+
+(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)
+ (let ((prefix
+ (concat (file-remote-p default-directory)
+ (expand-file-name prefix temporary-file-directory))))
+ (make-temp-file prefix 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-core)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ob-core.el ends here
diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el
index d6bbbbce3a..60ab8c598d 100644
--- a/lisp/org/ob-ditaa.el
+++ b/lisp/org/ob-ditaa.el
@@ -34,22 +34,43 @@
;; 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)
(require 'org-compat)
-(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-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)
+
+(defcustom org-babel-ditaa-java-cmd "java"
+ "Java executable to use when evaluating ditaa blocks."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-ditaa-eps-jar-path
+ (expand-file-name "DitaaEps.jar" (file-name-directory org-ditaa-jar-path))
+ "Path to the DitaaEps.jar executable."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
(defcustom org-ditaa-jar-option "-jar"
"Option for the ditaa jar file.
Do not leave leading or trailing spaces in this string."
@@ -69,16 +90,26 @@ This function is called by `org-babel-execute-src-block'."
(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 " "
+ (eps (cdr (assoc :eps params)))
+ (cmd (concat org-babel-ditaa-java-cmd
+ " " java " " org-ditaa-jar-option " "
(shell-quote-argument
- (expand-file-name org-ditaa-jar-path))
+ (expand-file-name
+ (if eps org-ditaa-eps-jar-path org-ditaa-jar-path)))
" " cmdline
" " (org-babel-process-file-name in-file)
- " " (org-babel-process-file-name out-file))))
+ " " (org-babel-process-file-name out-file)))
+ (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf")
+ (cdr (assoc :pdf params))))
+ (concat
+ "epstopdf"
+ " " (org-babel-process-file-name (concat in-file ".eps"))
+ " -o=" (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)
+ (when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd))
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:ditaa (session params)
diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el
index b5e78802b2..7504264137 100644
--- a/lisp/org/ob-dot.el
+++ b/lisp/org/ob-dot.el
@@ -39,7 +39,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-default-header-args:dot
'((:results . "file") (:exports . "results"))
diff --git a/lisp/org/ob-ebnf.el b/lisp/org/ob-ebnf.el
new file mode 100644
index 0000000000..8c98d305d3
--- /dev/null
+++ b/lisp/org/ob-ebnf.el
@@ -0,0 +1,85 @@
+;;; ob-ebnf.el --- org-babel functions for ebnf evaluation
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: Michael Gauland
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+;; Version: 1.00
+
+;;; 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 using ebnf2ps to generate encapsulated postscript
+;;; railroad diagrams. It recogises these arguments:
+;;;
+;;; :file is required; it must include the extension '.eps.' All the rules
+;;; in the block will be drawn in the same file. This is done by
+;;; inserting a '[<file>' comment at the start of the block (see the
+;;; documentation for ebnf-eps-buffer for more information).
+;;;
+;;; :style specifies a value in ebnf-style-database. This provides the
+;;; ability to customise the output. The style can also specify the
+;;; grammar syntax (by setting ebnf-syntax); note that only ebnf,
+;;; iso-ebnf, and yacc are supported by this file.
+
+;;; Requirements:
+
+;;; Code:
+(require 'ob)
+(require 'ebnf2ps)
+
+;; optionally declare default header arguments for this language
+(defvar org-babel-default-header-args:ebnf '((:style . nil)))
+
+;; Use ebnf-eps-buffer to produce an encapsulated postscript file.
+;;
+(defun org-babel-execute:ebnf (body params)
+ "Execute a block of Ebnf code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (save-excursion
+ (let* ((dest-file (cdr (assoc :file params)))
+ (dest-dir (file-name-directory dest-file))
+ (dest-root (file-name-sans-extension
+ (file-name-nondirectory dest-file)))
+ (dest-ext (file-name-extension dest-file))
+ (style (cdr (assoc :style params)))
+ (current-dir default-directory)
+ (result nil))
+ (with-temp-buffer
+ (when style (ebnf-push-style style))
+ (let ((comment-format
+ (cond ((string= ebnf-syntax 'yacc) "/*%s*/")
+ ((string= ebnf-syntax 'ebnf) ";%s")
+ ((string= ebnf-syntax 'iso-ebnf) "(*%s*)")
+ (t (setq result
+ (format "EBNF error: format %s not supported."
+ ebnf-syntax))))))
+ (setq ebnf-eps-prefix dest-dir)
+ (insert (format comment-format (format "[%s" dest-root)))
+ (newline)
+ (insert body)
+ (newline)
+ (insert (format comment-format (format "]%s" dest-root)))
+ (ebnf-eps-buffer)
+ (when style (ebnf-pop-style))))
+ result)))
+
+(provide 'ob-ebnf)
+;;; ob-ebnf.el ends here
diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el
index d6073ca8ef..886645dc9c 100644
--- a/lisp/org/ob-emacs-lisp.el
+++ b/lisp/org/ob-emacs-lisp.el
@@ -27,7 +27,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'ob-comint))
(defvar org-babel-default-header-args:emacs-lisp
'((:hlines . "yes") (:colnames . "no"))
@@ -56,11 +55,13 @@
"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-result-cond (cdr (assoc :result-params params))
+ (let ((print-level nil)
+ (print-length nil))
+ (if (or (member "scalar" (cdr (assoc :result-params params)))
+ (member "verbatim" (cdr (assoc :result-params params))))
+ (format "%S" result)
+ (format "%s" result)))
(org-babel-reassemble-table
result
(org-babel-pick-name (cdr (assoc :colname-names params))
diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el
index 22d2bcf288..85a8c4e31f 100644
--- a/lisp/org/ob-eval.el
+++ b/lisp/org/ob-eval.el
@@ -27,6 +27,7 @@
;; shell commands.
;;; Code:
+(require 'org-macs)
(eval-when-compile (require 'cl))
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
@@ -50,8 +51,8 @@ STDERR with `org-babel-eval-error-notify'."
(with-temp-buffer
(insert body)
(setq exit-code
- (org-babel-shell-command-on-region
- (point-min) (point-max) cmd t 'replace err-buff))
+ (org-babel--shell-command-on-region
+ (point-min) (point-max) cmd err-buff))
(if (or (not (numberp exit-code)) (> exit-code 0))
(progn
(with-current-buffer err-buff
@@ -64,79 +65,15 @@ STDERR with `org-babel-eval-error-notify'."
(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)
+(defun org-babel--shell-command-on-region (start end command 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 ((input-file (org-babel-temp-file "input-"))
- (error-file (if error-buffer (org-babel-temp-file "scor-") nil))
+Stripped down version of shell-command-on-region for internal use
+in Babel only. This lets us work around errors in the original
+function in various versions of Emacs.
+"
+ (let ((input-file (org-babel-temp-file "ob-input-"))
+ (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil))
;; Unfortunately, `executable-find' does not support file name
;; handlers. Therefore, we could use it in the local case
;; only.
@@ -154,96 +91,26 @@ specifies the value of ERROR-BUFFER."
;; workaround for now.
(unless (file-remote-p default-directory)
(delete-file error-file))
- (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))
- (write-region start end input-file)
- (delete-region start end)
- (setq exit-status
- (process-file shell-file-name input-file
- (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))
- (write-region (point-min) (point-max) input-file)
- (delete-region (point-min) (point-max))
- (setq exit-status
- (process-file shell-file-name input-file
- (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
- (process-file 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 input-file (file-exists-p input-file))
+ ;; we always call this with 'replace, remove conditional
+ ;; Replace specified region with output from command.
+ (let ((swap (< start end)))
+ (goto-char start)
+ (push-mark (point) 'nomsg)
+ (write-region start end input-file)
+ (delete-region start end)
+ (setq exit-status
+ (process-file shell-file-name input-file
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch command))
+ (when swap (exchange-point-and-mark)))
+
+ (when (and input-file (file-exists-p input-file)
+ ;; bind org-babel--debug-input around the call to keep
+ ;; the temporary input files available for inspection
+ (not (when (boundp 'org-babel--debug-input)
+ org-babel--debug-input)))
(delete-file input-file))
(when (and error-file (file-exists-p error-file))
@@ -258,8 +125,7 @@ specifies the value of ERROR-BUFFER."
(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)))))
+ (current-buffer)))
(delete-file error-file))
exit-status))
diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el
index 37a9f71cf5..c8479e36d7 100644
--- a/lisp/org/ob-exp.el
+++ b/lisp/org/ob-exp.el
@@ -23,8 +23,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
-(require 'ob)
-(require 'org-exp-blocks)
+(require 'ob-core)
(eval-when-compile
(require 'cl))
@@ -35,23 +34,31 @@
(declare-function org-babel-lob-get-info "ob-lob" ())
(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
+(declare-function org-between-regexps-p "org"
+ (start-re end-re &optional lim-up lim-down))
+(declare-function org-get-indentation "org" (&optional line))
(declare-function org-heading-components "org" ())
+(declare-function org-in-block-p "org" (names))
+(declare-function org-in-verbatim-emphasis "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))
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-context "org-element" ())
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-escape-code-in-string "org-src" (s))
(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."
+process. When set to 'inline-only, only inline code blocks will
+be executed."
:group 'org-babel
:version "24.1"
- :type 'boolean)
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Only inline code" inline-only)
+ (const :tag "Always" t)))
(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
(defun org-babel-exp-get-export-buffer ()
@@ -86,10 +93,10 @@ process."
results)))
(def-edebug-spec org-babel-exp-in-export-file (form body))
-(defun org-babel-exp-src-block (body &rest headers)
+(defun org-babel-exp-src-block (&rest headers)
"Process source block for export.
-Depending on the 'export' headers argument in replace the source
-code block with...
+Depending on the 'export' headers argument, replace the source
+code block like this:
both ---- display the code and the results
@@ -99,11 +106,12 @@ code ---- the default, display the code inside the block but do
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"
+none ---- do not display either code or results upon export
+
+Assume point is at the beginning of block's starting line."
(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)
@@ -114,11 +122,11 @@ none ----- do not display either code or results upon export"
(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))))
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (append (org-babel-params-from-properties lang)
+ (list raw-params))))))
(setf hash (org-babel-sha1-hash info)))
(org-babel-exp-do-export info 'block hash)))))
@@ -149,66 +157,156 @@ this template."
(let ((m (make-marker)))
(set-marker m end (current-buffer))
(setq end m)))
- (let ((rx (concat "\\(" org-babel-inline-src-block-regexp
+ (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)))))))))
+ (while (re-search-forward rx end t)
+ (save-excursion
+ (let* ((element (save-excursion
+ ;; If match is inline, point is at its
+ ;; end. Move backward so
+ ;; `org-element-context' can get the
+ ;; object, not the following one.
+ (backward-char)
+ (save-match-data (org-element-context))))
+ (type (org-element-type element)))
+ (when (memq type '(babel-call inline-babel-call inline-src-block))
+ (let ((beg-el (org-element-property :begin element))
+ (end-el (org-element-property :end element)))
+ (case type
+ (inline-src-block
+ (let* ((info (org-babel-parse-inline-src-block-match))
+ (params (nth 2 info)))
+ (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)))
+ (goto-char beg-el)
+ (let ((replacement (org-babel-exp-do-export info 'inline)))
+ (if (equal replacement "")
+ ;; Replacement code is empty: completely
+ ;; remove inline src block, including extra
+ ;; white space that might have been created
+ ;; when inserting results.
+ (delete-region beg-el
+ (progn (goto-char end-el)
+ (skip-chars-forward " \t")
+ (point)))
+ ;; Otherwise: remove inline src block but
+ ;; preserve following white spaces. Then
+ ;; insert value.
+ (delete-region beg-el
+ (progn (goto-char end-el)
+ (skip-chars-backward " \t")
+ (point)))
+ (insert replacement)))))
+ ((babel-call inline-babel-call)
+ (let* ((lob-info (org-babel-lob-get-info))
+ (results
+ (org-babel-exp-do-export
+ (list "emacs-lisp" "results"
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-lob-header-args
+ (append
+ (org-babel-params-from-properties)
+ (list
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat
+ ":var results="
+ (mapconcat 'identity
+ (butlast lob-info 2)
+ " ")))))))
+ "" (nth 3 lob-info) (nth 2 lob-info))
+ 'lob))
+ (rep (org-fill-template
+ org-babel-exp-call-line-template
+ `(("line" . ,(nth 0 lob-info))))))
+ ;; If replacement is empty, completely remove the
+ ;; object/element, including any extra white space
+ ;; that might have been created when including
+ ;; results.
+ (if (equal rep "")
+ (delete-region
+ beg-el
+ (progn (goto-char end-el)
+ (if (not (eq type 'babel-call))
+ (progn (skip-chars-forward " \t") (point))
+ (skip-chars-forward " \r\t\n")
+ (line-beginning-position))))
+ ;; Otherwise, preserve following white
+ ;; spaces/newlines and then, insert replacement
+ ;; string.
+ (goto-char beg-el)
+ (delete-region beg-el
+ (progn (goto-char end-el)
+ (skip-chars-backward " \r\t\n")
+ (point)))
+ (insert rep)))))))))))))
+
+(defvar org-src-preserve-indentation) ; From org-src.el
+(defun org-babel-exp-process-buffer ()
+ "Execute all blocks in visible part of buffer."
+ (interactive)
+ (save-window-excursion
+ (let ((case-fold-search t)
+ (pos (point-min)))
+ (goto-char pos)
+ (while (re-search-forward "^[ \t]*#\\+BEGIN_SRC" nil t)
+ (let ((element (save-match-data (org-element-at-point))))
+ (when (eq (org-element-type element) 'src-block)
+ (let* ((match-start (copy-marker (match-beginning 0)))
+ (begin (copy-marker (org-element-property :begin element)))
+ ;; Make sure we don't remove any blank lines after
+ ;; the block when replacing it.
+ (block-end (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (copy-marker (line-end-position))))
+ (ind (org-get-indentation))
+ (headers
+ (cons
+ (org-element-property :language element)
+ (let ((params (org-element-property :parameters element)))
+ (and params (org-split-string params "[ \t]+"))))))
+ ;; Execute all non-block elements between POS and
+ ;; current block.
+ (org-babel-exp-non-block-elements pos begin)
+ ;; Take care of matched block: compute replacement
+ ;; string. In particular, a nil REPLACEMENT means the
+ ;; block should be left as-is while an empty string
+ ;; should remove the block.
+ (let ((replacement (progn (goto-char match-start)
+ (org-babel-exp-src-block headers))))
+ (cond ((not replacement) (goto-char block-end))
+ ((equal replacement "")
+ (delete-region begin
+ (progn (goto-char block-end)
+ (skip-chars-forward " \r\t\n")
+ (if (eobp) (point)
+ (line-beginning-position)))))
+ (t
+ (goto-char match-start)
+ (delete-region (point) block-end)
+ (insert replacement)
+ (if (org-element-property :preserve-indent element)
+ ;; Indent only the code block markers.
+ (save-excursion (skip-chars-backward " \r\t\n")
+ (indent-line-to ind)
+ (goto-char match-start)
+ (indent-line-to ind))
+ ;; Indent everything.
+ (indent-rigidly match-start (point) ind)))))
+ (setq pos (line-beginning-position))
+ ;; Cleanup markers.
+ (set-marker match-start nil)
+ (set-marker begin nil)
+ (set-marker block-end nil)))))
+ ;; Eventually execute all non-block Babel elements between last
+ ;; src-block and end of buffer.
+ (org-babel-exp-non-block-elements pos (point-max)))))
(defun org-babel-in-example-or-verbatim ()
"Return true if point is in example or verbatim code.
@@ -269,9 +367,7 @@ replaced with its value."
(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)))
+ ("body" . ,(org-escape-code-in-string (nth 1 info)))
,@(mapcar (lambda (pair)
(cons (substring (symbol-name (car pair)) 1)
(format "%S" (cdr pair))))
@@ -285,14 +381,17 @@ 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
+ (when (and (or (eq org-export-babel-evaluate t)
+ (and (eq type 'inline)
+ (eq org-export-babel-evaluate 'inline-only)))
(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)))
+ (info (copy-sequence info))
+ (org-babel-current-src-block-location (point-marker)))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
@@ -318,10 +417,10 @@ inhibit insertion of results into the buffer."
((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)
+ (let (org-confirm-babel-evaluate)
+ (org-babel-execute-src-block nil info))))))))))
+(provide 'ob-exp)
;;; ob-exp.el ends here
diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el
index 8d5012fb82..df7bfa00c1 100644
--- a/lisp/org/ob-fortran.el
+++ b/lisp/org/ob-fortran.el
@@ -28,11 +28,11 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(require 'cc-mode)
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
+(declare-function org-every "org" (pred seq))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
@@ -62,11 +62,11 @@
(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-result-cond (cdr (assoc :result-params params))
+ (org-babel-read results)
+ (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-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@@ -144,6 +144,12 @@ of the same value."
((stringp val)
(format "character(len=%d), parameter :: %S = '%s'\n"
(length val) var val))
+ ;; val is a matrix
+ ((and (listp val) (org-every #'listp val))
+ (format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n"
+ var (length val) (length (car val))
+ (org-babel-fortran-transform-list val)
+ (length (car val)) (length val)))
((listp val)
(format "real, parameter :: %S(%d) = %s\n"
var (length val) (org-babel-fortran-transform-list val)))
diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el
index 488d2508e6..cc9186b1ad 100644
--- a/lisp/org/ob-gnuplot.el
+++ b/lisp/org/ob-gnuplot.el
@@ -39,8 +39,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
(eval-when-compile (require 'cl))
(declare-function org-time-string-to-time "org" (s))
@@ -54,77 +52,117 @@
'((:results . "file") (:exports . "results") (:session . nil))
"Default arguments to use when evaluating a gnuplot source block.")
+(defvar org-babel-header-args:gnuplot
+ '((title . :any)
+ (lines . :any)
+ (sets . :any)
+ (x-labels . :any)
+ (y-labels . :any)
+ (timefmt . :any)
+ (time-ind . :any)
+ (missing . :any)
+ (term . :any))
+ "Gnuplot specific header args.")
+
(defvar org-babel-gnuplot-timestamp-fmt nil)
+(defvar *org-babel-gnuplot-missing* nil)
+
+(defcustom *org-babel-gnuplot-terms*
+ '((eps . "postscript eps"))
+ "List of file extensions and the associated gnuplot terminal."
+ :group 'org-babel
+ :type '(repeat (cons (symbol :tag "File extension")
+ (string :tag "Gnuplot terminal"))))
+
(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))))
+ (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params))))
+ (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))))
+ (prologue (cdr (assoc :prologue params)))
+ (epilogue (cdr (assoc :epilogue params)))
+ (term (or (cdr (assoc :term params))
+ (when out-file
+ (let ((ext (file-name-extension out-file)))
+ (or (cdr (assoc (intern (downcase ext))
+ *org-babel-gnuplot-terms*))
+ ext)))))
(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)
+ (title (cdr (assoc :title params)))
+ (lines (cdr (assoc :line params)))
+ (sets (cdr (assoc :set params)))
+ (x-labels (cdr (assoc :xlabels params)))
+ (y-labels (cdr (assoc :ylabels params)))
+ (timefmt (cdr (assoc :timefmt params)))
+ (time-ind (or (cdr (assoc :timeind params))
(when timefmt 1)))
+ (missing (cdr (assoc :missing params)))
(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 title (funcall add-to-body (format "set title '%s'" title)))
+ (when lines (mapc (lambda (el) (funcall add-to-body el)) lines))
+ (when missing
+ (funcall add-to-body (format "set datafile missing '%s'" missing)))
(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)))
+ (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)))
+ (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 out-file
+ ;; set the terminal at the top of the block
+ (funcall add-to-body (format "set output \"%s\"" out-file))
+ ;; and close the terminal at the bottom of the block
+ (setq body (concat body "\nset output\n")))
(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"))
+ (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))
+ vars)
+ (when prologue (funcall add-to-body prologue))
+ (when epilogue (setq body (concat body "\n" epilogue))))
body))
(defun org-babel-execute:gnuplot (body params)
@@ -201,7 +239,8 @@ then create one. Return the initialized session. The current
(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)))
+ (format-time-string org-babel-gnuplot-timestamp-fmt
+ (org-time-string-to-time s)))
(defvar org-table-number-regexp)
(defvar org-ts-regexp3)
@@ -212,7 +251,12 @@ then create one. Return the initialized session. The current
(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 "\"") "\"\"") "\""))))
+ (if (zerop (length s))
+ (or *org-babel-gnuplot-missing* s)
+ (if (string-match "[ \"]" "?")
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"")
+ "\"")
+ s)))))
(defun org-babel-gnuplot-table-to-data (table data-file params)
"Export TABLE to DATA-FILE in a format readable by gnuplot.
diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el
index eca6d829c1..a012711916 100644
--- a/lisp/org/ob-haskell.el
+++ b/lisp/org/ob-haskell.el
@@ -40,7 +40,6 @@
;;; Code:
(require 'ob)
-(require 'ob-comint)
(require 'comint)
(eval-when-compile (require 'cl))
@@ -53,7 +52,8 @@
(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-default-header-args:haskell
+ '((:padlines . "no")))
(defvar org-babel-haskell-lhs2tex-command "lhs2tex")
@@ -79,11 +79,12 @@
(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))))
+ ((lambda (result)
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ result (org-babel-haskell-table-or-string result)))
+ (case result-type
+ ('output (mapconcat #'identity (reverse (cdr results)) "\n"))
+ ('value (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))
@@ -147,8 +148,9 @@ specifying a variable of the same value."
(format "%S" var)))
(defvar org-src-preserve-indentation)
-(declare-function org-export-as-latex "org-latex"
- (arg &optional ext-plist to-buffer body-only pub-dir))
+(declare-function org-export-to-file "ox"
+ (backend file
+ &optional async subtreep visible-only body-only ext-plist))
(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
@@ -192,7 +194,11 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(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)
+ (require 'ox-latex)
+ (find-file tmp-org-file)
+ ;; Ensure we do not clutter kill ring with incomplete results.
+ (let (org-export-copy-to-kill-ring)
+ (org-export-to-file 'latex tmp-tex-file))
(kill-buffer nil)
(delete-file tmp-org-file)
(find-file tmp-tex-file)
diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el
index d4686a98ee..af18f7468c 100644
--- a/lisp/org/ob-io.el
+++ b/lisp/org/ob-io.el
@@ -33,9 +33,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
@@ -98,8 +95,8 @@ in BODY as elisp."
(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-result-cond result-params
+ raw
(org-babel-io-table-or-string raw)))
(org-babel-eval
(concat org-babel-io-command " " src-file) ""))))))
diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el
index 96128ed152..c0e9a5384c 100644
--- a/lisp/org/ob-java.el
+++ b/lisp/org/ob-java.el
@@ -28,7 +28,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))
@@ -58,11 +57,11 @@
(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-")))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-read results)
+ (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-import-elisp-from-file tmp-file)))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el
index 4e4c3abfa1..78914bc2c6 100644
--- a/lisp/org/ob-js.el
+++ b/lisp/org/ob-js.el
@@ -39,9 +39,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function run-mozilla "ext:moz" (arg))
@@ -68,30 +65,32 @@ 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)) ""))))))
+ body params (org-babel-variable-assignments:js params)))
+ (result (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)) "")))))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ result (org-babel-js-read result))))
(defun org-babel-js-read (results)
"Convert RESULTS into an appropriate elisp value.
diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el
index 01a54ca87d..6cc7387e16 100644
--- a/lisp/org/ob-keys.el
+++ b/lisp/org/ob-keys.el
@@ -29,7 +29,7 @@
;; functions and their associated keys.
;;; Code:
-(require 'ob)
+(require 'ob-core)
(defvar org-babel-key-prefix "\C-c\C-v"
"The key prefix for Babel interactive key-bindings.
diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el
index 104f971c67..edc9fe8813 100644
--- a/lisp/org/ob-latex.el
+++ b/lisp/org/ob-latex.el
@@ -35,24 +35,32 @@
(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" ())
+(declare-function org-latex-guess-inputenc "ox-latex" (header))
+(declare-function org-latex-compile "ox-latex" (file))
+
(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-format-latex-header) ; From org.el
+(defvar org-format-latex-options) ; From org.el
+(defvar org-latex-default-packages-alist) ; From org.el
+(defvar org-latex-packages-alist) ; From org.el
(defvar org-babel-default-header-args:latex
'((:results . "latex") (:exports . "results"))
"Default arguments to use when evaluating a LaTeX source block.")
+(defcustom org-babel-latex-htlatex nil
+ "The htlatex command to enable conversion of latex to SVG or HTML."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-latex-htlatex-packages
+ '("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}")
+ "Packages to use for htlatex export."
+ :group 'org-babel
+ :type '(list string))
+
(defun org-babel-expand-body:latex (body params)
"Expand BODY according to PARAMS, return the expanded body."
(mapc (lambda (pair) ;; replace variables
@@ -81,28 +89,32 @@ This function is called by `org-babel-execute-src-block'."
(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)))
+ (org-latex-packages-alist
+ (append (cdr (assoc :packages params)) org-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)
+ ((string-match "\\.tikz$" out-file)
+ (when (file-exists-p out-file) (delete-file out-file))
+ (with-temp-file out-file
+ (insert body)))
+ ((or (string-match "\\.pdf$" out-file) imagemagick)
(with-temp-file tex-file
+ (require 'ox-latex)
(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)
+ (org-latex-guess-inputenc
+ (org-splice-latex-header
+ org-format-latex-header
+ (delq
+ nil
+ (mapcar
+ (lambda (el)
+ (unless (and (listp el) (string= "hyperref" (cadr el)))
+ el))
+ org-latex-default-packages-alist))
+ org-latex-packages-alist
+ nil))
(if fit "\n\\usepackage[active, tightpage]{preview}\n" "")
(if border (format "\\setlength{\\PreviewBorder}{%s}" border) "")
(if height (concat "\n" (format "\\pdfpageheight %s" height)) "")
@@ -113,14 +125,10 @@ This function is called by `org-babel-execute-src-block'."
(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))
+ (concat "\n\\begin{document}\n" body "\n\\end{document}\n"))))
(when (file-exists-p out-file) (delete-file out-file))
(let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file)))
(cond
@@ -131,13 +139,46 @@ This function is called by `org-babel-execute-src-block'."
transient-pdf-file out-file im-in-options im-out-options)
(when (file-exists-p transient-pdf-file)
(delete-file transient-pdf-file))))))
+ ((and (or (string-match "\\.svg$" out-file)
+ (string-match "\\.html$" out-file))
+ org-babel-latex-htlatex)
+ (with-temp-file tex-file
+ (insert (concat
+ "\\documentclass[preview]{standalone}
+\\def\\pgfsysdriver{pgfsys-tex4ht.def}
+"
+ (mapconcat (lambda (pkg)
+ (concat "\\usepackage" pkg))
+ org-babel-latex-htlatex-packages
+ "\n")
+ "\\begin{document}"
+ body
+ "\\end{document}")))
+ (when (file-exists-p out-file) (delete-file out-file))
+ (let ((default-directory (file-name-directory tex-file)))
+ (shell-command (format "%s %s" org-babel-latex-htlatex tex-file)))
+ (cond
+ ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg"))
+ (if (string-match "\\.svg$" out-file)
+ (progn
+ (shell-command "pwd")
+ (shell-command (format "mv %s %s"
+ (concat (file-name-sans-extension tex-file) "-1.svg")
+ out-file)))
+ (error "SVG file produced but HTML file requested.")))
+ ((file-exists-p (concat (file-name-sans-extension tex-file) ".html"))
+ (if (string-match "\\.html$" out-file)
+ (shell-command "mv %s %s"
+ (concat (file-name-sans-extension tex-file)
+ ".html")
+ out-file)
+ (error "HTML file produced but SVG file requested.")))))
((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 " "
@@ -146,55 +187,14 @@ This function is called by `org-babel-execute-src-block'."
(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)))
+ "Generate a pdf file according to the contents FILE."
+ (require 'ox-latex)
+ (org-latex-compile file))
(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)
-
-
+(provide 'ob-latex)
;;; ob-latex.el ends here
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index 0554a36ab0..6080a5a7c0 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -30,10 +30,7 @@
;; http://lilypond.org/manuals.html
;;; Code:
-
(require 'ob)
-(require 'ob-eval)
-(require 'ob-tangle)
(require 'outline)
(defalias 'lilypond-mode 'LilyPond-mode)
@@ -155,7 +152,11 @@ specific arguments to =org-babel-tangle="
" -dbackend=eps "
"-dno-gs-load-fonts "
"-dinclude-eps-fonts "
- "--png "
+ (or (cdr (assoc (file-name-extension out-file)
+ '(("pdf" . "--pdf ")
+ ("ps" . "--ps ")
+ ("png" . "--png "))))
+ "--png ")
"--output="
(file-name-sans-extension out-file)
" "
diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el
index 4ff9718553..2bb1a25bfb 100644
--- a/lisp/org/ob-lisp.el
+++ b/lisp/org/ob-lisp.el
@@ -76,8 +76,8 @@ current directory string."
(require 'slime)
(org-babel-reassemble-table
((lambda (result)
- (if (member "output" (cdr (assoc :result-params params)))
- (car result)
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (car result)
(condition-case nil
(read (org-babel-lisp-vector-to-list (cadr result)))
(error (cadr result)))))
diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el
index 3727829359..d37940a188 100644
--- a/lisp/org/ob-lob.el
+++ b/lisp/org/ob-lob.el
@@ -25,7 +25,7 @@
;;; Code:
(eval-when-compile
(require 'cl))
-(require 'ob)
+(require 'ob-core)
(require 'ob-table)
(declare-function org-babel-in-example-or-verbatim "ob-exp" nil)
@@ -35,7 +35,7 @@
This is an association list. Populate the library by adding
files to `org-babel-lob-files'.")
-(defcustom org-babel-lob-files '()
+(defcustom org-babel-lob-files nil
"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
@@ -114,29 +114,45 @@ if so then run the appropriate source block from the Library."
(or (funcall nonempty 8 19) ""))
(funcall nonempty 9 18)))
(list (length (if (= (length (match-string 12)) 0)
- (match-string 2) (match-string 11)))))))))
-
+ (match-string 2) (match-string 11)))
+ (save-excursion
+ (forward-line -1)
+ (and (looking-at (concat org-babel-src-name-regexp
+ "\\([^\n]*\\)$"))
+ (org-no-properties (match-string 1))))))))))
+
+(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el
(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) " "))))))
+ (let* ((mkinfo (lambda (p)
+ (list "emacs-lisp" "results" p nil
+ (nth 3 info) ;; name
+ (nth 2 info))))
+ (pre-params (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-header-args:emacs-lisp
+ (append
+ (org-babel-params-from-properties)
+ (list
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat
+ ":var results="
+ (mapconcat #'identity (butlast info 2)
+ " "))))))))
(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))
+ (cache-p (and (cdr (assoc :cache pre-params))
+ (string= "yes" (cdr (assoc :cache pre-params)))))
+ (new-hash (when cache-p (org-babel-sha1-hash pre-info)))
+ (old-hash (when cache-p (org-babel-current-result-hash)))
+ (org-babel-current-src-block-location (point-marker)))
+ (if (and cache-p (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)))
+ (prog1 (let* ((proc-params (org-babel-process-params pre-params))
+ org-confirm-babel-evaluate)
+ (org-babel-execute-src-block nil (funcall mkinfo proc-params)))
;; update the hash
(when new-hash (org-babel-set-current-result-hash new-hash))))))
diff --git a/lisp/org/ob-makefile.el b/lisp/org/ob-makefile.el
new file mode 100644
index 0000000000..7b0ff932c4
--- /dev/null
+++ b/lisp/org/ob-makefile.el
@@ -0,0 +1,47 @@
+;;; ob-makefile.el --- org-babel functions for makefile evaluation
+
+;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte and Thomas S. Dye
+;; 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 file exists solely for tangling a Makefile from org-mode files.
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-default-header-args:makefile '())
+
+(defun org-babel-execute:makefile (body params)
+ "Execute a block of makefile code.
+This function is called by `org-babel-execute-src-block'."
+ body)
+
+(defun org-babel-prep-session:makefile (session params)
+ "Return an error if the :session header argument is set. Make
+does not support sessions."
+ (error "Makefile sessions are nonsensical"))
+
+(provide 'ob-makefile)
+
+
+
+;;; ob-makefile.el ends here
diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el
index 4a91ca9b28..726d6863e4 100644
--- a/lisp/org/ob-maxima.el
+++ b/lisp/org/ob-maxima.el
@@ -83,16 +83,15 @@ called by `org-babel-execute-src-block'."
(mapcar (lambda (line)
(unless (or (string-match "batch" line)
(string-match "^rat: replaced .*$" line)
+ (string-match "^;;; Loading #P" 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
+ (org-babel-result-cond 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))))))
diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el
index 5838d7dec7..209ad7dcc3 100644
--- a/lisp/org/ob-mscgen.el
+++ b/lisp/org/ob-mscgen.el
@@ -55,7 +55,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-default-header-args:mscgen
'((:results . "file") (:exports . "results"))
diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el
index bff41f8f1c..25f79c5b77 100644
--- a/lisp/org/ob-ocaml.el
+++ b/lisp/org/ob-ocaml.el
@@ -36,11 +36,11 @@
;;; Code:
(require 'ob)
-(require 'ob-comint)
(require 'comint)
(eval-when-compile (require 'cl))
(declare-function tuareg-run-caml "ext:tuareg" ())
+(declare-function tuareg-run-ocaml "ext:tuareg" ())
(declare-function tuareg-interactive-send-input "ext:tuareg" ())
(defvar org-babel-tangle-lang-exts)
@@ -51,6 +51,13 @@
(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe")
+(defcustom org-babel-ocaml-command "ocaml"
+ "Name of the command for executing Ocaml code."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-babel
+ :type 'string)
+
(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)))
@@ -63,7 +70,7 @@
(session org-babel-ocaml-eoe-output t full-body)
(insert
(concat
- (org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator))
+ (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)
@@ -74,7 +81,14 @@
(progn (setq out t) nil))))
(mapcar #'org-babel-trim (reverse raw))))))))
(org-babel-reassemble-table
- (org-babel-ocaml-parse-output (org-babel-trim clean))
+ (let ((raw (org-babel-trim clean))
+ (result-params (cdr (assoc :result-params params))))
+ (org-babel-result-cond result-params
+ ;; strip type information from output unless verbatim is specified
+ (if (and (not (member "verbatim" result-params))
+ (string-match "= \\(.+\\)$" raw))
+ (match-string 1 raw) raw)
+ (org-babel-ocaml-parse-output raw)))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@@ -89,8 +103,10 @@
(stringp session))
session
tuareg-interactive-buffer-name)))
- (save-window-excursion (tuareg-run-caml)
- (get-buffer tuareg-interactive-buffer-name))))
+ (save-window-excursion (if (fboundp 'tuareg-run-process-if-needed)
+ (tuareg-run-process-if-needed org-babel-ocaml-command)
+ (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."
@@ -108,7 +124,7 @@
(defun org-babel-ocaml-parse-output (output)
"Parse OUTPUT.
OUTPUT is string output from an ocaml process."
- (let ((regexp "%s = \\(.+\\)$"))
+ (let ((regexp "[^:]+ : %s = \\(.+\\)$"))
(cond
((string-match (format regexp "string") output)
(org-babel-read (match-string 1 output)))
diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el
index 3394d579ae..40bedfdb13 100644
--- a/lisp/org/ob-octave.el
+++ b/lisp/org/ob-octave.el
@@ -30,9 +30,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function matlab-shell "ext:matlab-mode")
@@ -154,7 +151,8 @@ create. Return the initialized session."
"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))
+ (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror)
+ (require 'octave)))
(unless (string= session "none")
(let ((session (or session
(if matlabp "*Inferior Matlab*" "*Inferior Octave*"))))
diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el
index a5cd96a75b..892c56c25b 100644
--- a/lisp/org/ob-org.el
+++ b/lisp/org/ob-org.el
@@ -29,7 +29,8 @@
;;; Code:
(require 'ob)
-(declare-function org-export-string "org-exp" (string fmt &optional dir))
+(declare-function org-export-string-as "ox"
+ (string backend &optional body-only ext-plist))
(defvar org-babel-default-header-args:org
'((:results . "raw silent") (:exports . "code"))
@@ -42,8 +43,9 @@
(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)))
+ (regexp-quote (format "$%s" (car var)))
+ (format "%s" (cdr var))
+ body nil 'literal)))
body)
(defun org-babel-execute:org (body params)
@@ -53,10 +55,10 @@ This function is called by `org-babel-execute-src-block'."
(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"))
+ ((member "latex" result-params)
+ (org-export-string-as (concat "#+Title: \n" body) 'latex t))
+ ((member "html" result-params) (org-export-string-as body 'html t))
+ ((member "ascii" result-params) (org-export-string-as body 'ascii t))
(t body))))
(defun org-babel-prep-session:org (session params)
diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el
index b37df807ae..43ab9467c1 100644
--- a/lisp/org/ob-perl.el
+++ b/lisp/org/ob-perl.el
@@ -28,7 +28,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts)
@@ -49,7 +48,7 @@ This function is called by `org-babel-execute-src-block'."
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-perl-evaluate session full-body result-type result-params)
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@@ -63,20 +62,33 @@ This function is called by `org-babel-execute-src-block'."
"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))))
+ (org-babel-perl--var-to-perl (cdr pair) (car pair)))
(mapcar #'cdr (org-babel-get-header params :var))))
;; helper functions
-(defun org-babel-perl-var-to-perl (var)
+(defvar org-babel-perl-var-wrap "q(%s)"
+ "Wrapper for variables inserted into Perl code.")
+
+(defvar org-babel-perl--lvl)
+(defun org-babel-perl--var-to-perl (var &optional varn)
"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)))
+ (if varn
+ (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix)
+ (concat "my $" (symbol-name varn) "=" (when lvar "\n")
+ (org-babel-perl--var-to-perl var)
+ ";\n"))
+ (let ((prefix (make-string (* 2 org-babel-perl--lvl) ?\ )))
+ (concat prefix
+ (if (listp var)
+ (let ((org-babel-perl--lvl (1+ org-babel-perl--lvl)))
+ (concat "[\n"
+ (mapconcat #'org-babel-perl--var-to-perl var "")
+ prefix "]"))
+ (format "q(%s)" var))
+ (unless (zerop org-babel-perl--lvl) ",\n")))))
(defvar org-babel-perl-buffers '(:default . nil))
@@ -84,32 +96,60 @@ specifying a var of the same value."
"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-wrapper-method "{
+ my $babel_sub = sub {
+ %s
+ };
+ open my $BOH, qq(>%s) or die qq(Perl: Could not open output file.$/);
+ my $rv = &$babel_sub();
+ my $rt = ref $rv;
+ select $BOH;
+ if (qq(ARRAY) eq $rt) {
+ local $\\=$/;
+ local $,=qq(\t);
+ foreach my $rv ( @$rv ) {
+ my $rt = ref $rv;
+ if (qq(ARRAY) eq $rt) {
+ print @$rv;
+ } else {
+ print $rv;
+ }
+ }
+ } else {
+ print $rv;
+ }
+}")
+
+(defvar org-babel-perl-preface nil)
(defvar org-babel-perl-pp-wrapper-method
nil)
-(defun org-babel-perl-evaluate (session body &optional result-type)
+(defun org-babel-perl-evaluate (session ibody &optional result-type result-params)
"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)))))
+ (let* ((body (concat org-babel-perl-preface ibody))
+ (tmp-file (org-babel-temp-file "perl-"))
+ (tmp-babel-file (org-babel-process-file-name
+ tmp-file 'noquote)))
+ ((lambda (results)
+ (when results
+ (org-babel-result-cond result-params
+ (org-babel-eval-read-file tmp-file)
+ (org-babel-import-elisp-from-file tmp-file '(16)))))
+ (case result-type
+ (output
+ (with-temp-file tmp-file
+ (insert
+ (org-babel-eval org-babel-perl-command body))
+ (buffer-string)))
+ (value
+ (org-babel-eval org-babel-perl-command
+ (format org-babel-perl-wrapper-method
+ body tmp-babel-file)))))))
(provide 'ob-perl)
diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el
index 1029b6f2a9..1d1791926c 100644
--- a/lisp/org/ob-picolisp.el
+++ b/lisp/org/ob-picolisp.el
@@ -54,8 +54,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
-(require 'ob-comint)
(require 'comint)
(eval-when-compile (require 'cl))
@@ -80,7 +78,7 @@
:version "24.1"
:type 'string)
-(defun org-babel-expand-body:picolisp (body params &optional processed-params)
+(defun org-babel-expand-body:picolisp (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)))
@@ -123,13 +121,8 @@
(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
+ (org-babel-result-cond result-params
+ result
(read result)))
(if (not (string= session-name "none"))
;; session based evaluation
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index bb52c376b4..c17d4448a3 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -35,7 +35,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-default-header-args:plantuml
'((:results . "file") (:exports . "results"))
diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el
index 79cc53ea0f..17da109ca0 100644
--- a/lisp/org/ob-python.el
+++ b/lisp/org/ob-python.el
@@ -28,30 +28,50 @@
;;; 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))
+(declare-function run-python "ext:python" (cmd &optional dedicated show))
(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 the command for executing Python code.")
+(defcustom org-babel-python-command "python"
+ "Name of the command for executing Python code."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-babel
+ :type 'string)
-(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python)
+(defcustom org-babel-python-mode
+ (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python)
"Preferred python mode for use in running python interactively.
-This will typically be either 'python or 'python-mode.")
+This will typically be either 'python or 'python-mode."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
(defvar org-src-preserve-indentation)
+(defcustom org-babel-python-hline-to "None"
+ "Replace hlines in incoming tables with this when translating to python."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-babel-python-None-to 'hline
+ "Replace 'None' in python tables with this before returning."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
(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'."
@@ -114,7 +134,7 @@ specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]")
(if (equal var 'hline)
- "None"
+ org-babel-python-hline-to
(format
(if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
var))))
@@ -123,14 +143,34 @@ specifying a variable of the same value."
"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))
+ ((lambda (res)
+ (if (listp res)
+ (mapcar (lambda (el) (if (equal el 'None)
+ org-babel-python-None-to el))
+ res)
+ res))
+ (org-babel-script-escape results)))
-(defvar org-babel-python-buffers '((:default . nil)))
+(defvar org-babel-python-buffers '((:default . "*Python*")))
(defun org-babel-python-session-buffer (session)
"Return the buffer associated with SESSION."
(cdr (assoc session org-babel-python-buffers)))
+(defun org-babel-python-with-earmufs (session)
+ (let ((name (if (stringp session) session (format "%s" session))))
+ (if (and (string= "*" (substring name 0 1))
+ (string= "*" (substring name (- (length name) 1))))
+ name
+ (format "*%s*" name))))
+
+(defun org-babel-python-without-earmufs (session)
+ (let ((name (if (stringp session) session (format "%s" session))))
+ (if (and (string= "*" (substring name 0 1))
+ (string= "*" (substring name (- (length name) 1))))
+ (substring name 1 (- (length name) 1))
+ name)))
+
(defvar py-default-interpreter)
(defun org-babel-python-initiate-session-by-key (&optional session)
"Initiate a python session.
@@ -139,13 +179,20 @@ 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)))
+ (python-buffer (org-babel-python-session-buffer session))
+ (cmd (if (member system-type '(cygwin windows-nt ms-dos))
+ (concat org-babel-python-command " -i")
+ org-babel-python-command)))
(cond
((and (eq 'python org-babel-python-mode)
(fboundp 'run-python)) ; python.el
- (if (version< "24.1" emacs-version)
- (run-python org-babel-python-command)
- (run-python)))
+ (if (not (version< "24.1" emacs-version))
+ (run-python cmd)
+ (unless python-buffer
+ (setq python-buffer (org-babel-python-with-earmufs session)))
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmufs python-buffer)))
+ (run-python cmd))))
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
;; Make sure that py-which-bufname is initialized, as otherwise
@@ -160,7 +207,7 @@ then create. Return the initialized session."
(concat "Python-" (symbol-name session))))
(py-which-bufname bufname))
(py-shell)
- (setq python-buffer (concat "*" bufname "*"))))
+ (setq python-buffer (org-babel-python-with-earmufs bufname))))
(t
(error "No function available for running an inferior Python")))
(setq org-babel-python-buffers
@@ -206,11 +253,8 @@ 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-result-cond result-params
+ raw
(org-babel-python-table-or-string (org-babel-trim raw))))
(case result-type
(output (org-babel-eval org-babel-python-command
@@ -259,11 +303,8 @@ last statement in BODY, as elisp."
(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-result-cond result-params
+ results
(org-babel-python-table-or-string results))))
(case result-type
(output
diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el
index 389c36318e..5a3c8ba2e4 100644
--- a/lisp/org/ob-ref.el
+++ b/lisp/org/ob-ref.el
@@ -40,7 +40,7 @@
;; So an example of a simple src block referencing table data in the
;; same file would be
-;; #+TBLNAME: sandbox
+;; #+NAME: sandbox
;; | 1 | 2 | 3 |
;; | 4 | org-babel | 6 |
;;
@@ -49,7 +49,7 @@
;; #+end_src
;;; Code:
-(require 'ob)
+(require 'ob-core)
(eval-when-compile
(require 'cl))
@@ -83,7 +83,10 @@ the variable."
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
- (let ((out (org-babel-read ref)))
+ (let ((out (save-excursion
+ (when org-babel-current-src-block-location
+ (goto-char org-babel-current-src-block-location))
+ (org-babel-read ref))))
(if (equal out ref)
(if (string-match "^\".*\"$" ref)
(read ref)
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index 747c6fc3da..af52831439 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -37,9 +37,6 @@
;;; 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))
@@ -53,6 +50,22 @@
(defvar org-babel-ruby-command "ruby"
"Name of command to use for executing ruby code.")
+(defcustom org-babel-ruby-hline-to "nil"
+ "Replace hlines in incoming tables with this when translating to ruby."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-babel-ruby-nil-to 'hline
+ "Replace 'nil' in ruby tables with this before returning."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+
+
(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'."
@@ -71,7 +84,9 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-ruby-evaluate
session full-body result-type result-params))))
(org-babel-reassemble-table
- result
+ (org-babel-result-cond result-params
+ result
+ (org-babel-ruby-table-or-string result))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
@@ -116,13 +131,21 @@ 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)))
+ (if (equal var 'hline)
+ org-babel-ruby-hline-to
+ (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))
+ ((lambda (res)
+ (if (listp res)
+ (mapcar (lambda (el) (if (equal el 'nil)
+ org-babel-ruby-nil-to el))
+ res)
+ res))
+ (org-babel-script-escape results)))
(defun org-babel-ruby-initiate-session (&optional session params)
"Initiate a ruby session.
@@ -206,31 +229,27 @@ return the value of the last statement in BODY, as elisp."
(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)))))))
+ (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."
diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el
index 60a10dbee5..cdb75bea09 100644
--- a/lisp/org/ob-sass.el
+++ b/lisp/org/ob-sass.el
@@ -39,7 +39,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-default-header-args:sass '())
diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el
index 3a07b344b2..7cb3099c00 100644
--- a/lisp/org/ob-scala.el
+++ b/lisp/org/ob-scala.el
@@ -31,9 +31,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
@@ -104,8 +101,8 @@ in BODY as elisp."
(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-result-cond result-params
+ raw
(org-babel-scala-table-or-string raw)))
(org-babel-eval
(concat org-babel-scala-command " " src-file) ""))))))
diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el
index bd7ea823f7..f979640a5a 100644
--- a/lisp/org/ob-scheme.el
+++ b/lisp/org/ob-scheme.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
-;; Author: Eric Schulte
+;; Authors: Eric Schulte, Michael Gauland
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: http://orgmode.org
@@ -33,30 +33,25 @@
;; - 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
+;; - for session based evaluation geiser is required, which is available from
+;; ELPA.
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
-(eval-when-compile (require 'cl))
+(require 'geiser nil t)
+(defvar geiser-repl--repl) ; Defined in geiser-repl.el
+(defvar geiser-impl--implementation) ; Defined in geiser-impl.el
+(defvar geiser-default-implementation) ; Defined in geiser-impl.el
+(defvar geiser-active-implementations) ; Defined in geiser-impl.el
-(declare-function run-scheme "ext:cmuscheme" (cmd))
+(declare-function run-geiser "geiser-repl" (impl))
+(declare-function geiser-mode "geiser-mode" ())
+(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg))
+(declare-function geiser-repl-exit "geiser-repl" (&optional arg))
(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))))
@@ -68,70 +63,127 @@
")\n" body ")")
body)))
-(defvar scheme-program-name)
+
+(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal)
+ "Map of scheme sessions to session names.")
+
+(defun org-babel-scheme-cleanse-repl-map ()
+ "Remove dead buffers from the REPL map."
+ (maphash
+ (lambda (x y)
+ (when (not (buffer-name y))
+ (remhash x org-babel-scheme-repl-map)))
+ org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-session-buffer (session-name)
+ "Look up the scheme buffer for a session; return nil if it doesn't exist."
+ (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions
+ (gethash session-name org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-set-session-buffer (session-name buffer)
+ "Record the scheme buffer used for a given session."
+ (puthash session-name buffer org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-buffer-impl (buffer)
+ "Returns the scheme implementation geiser associates with the buffer."
+ (with-current-buffer (set-buffer buffer)
+ geiser-impl--implementation))
+
+(defun org-babel-scheme-get-repl (impl name)
+ "Switch to a scheme REPL, creating it if it doesn't exist:"
+ (let ((buffer (org-babel-scheme-get-session-buffer name)))
+ (or buffer
+ (progn
+ (run-geiser impl)
+ (if name
+ (progn
+ (rename-buffer name t)
+ (org-babel-scheme-set-session-buffer name (current-buffer))))
+ (current-buffer)))))
+
+(defun org-babel-scheme-make-session-name (buffer name impl)
+ "Generate a name for the session buffer.
+
+For a named session, the buffer name will be the session name.
+
+If the session is unnamed (nil), generate a name.
+
+If the session is 'none', use nil for the session name, and
+org-babel-scheme-execute-with-geiser will use a temporary session."
+ (let ((result
+ (cond ((not name)
+ (concat buffer " " (symbol-name impl) " REPL"))
+ ((string= name "none") nil)
+ (name))))
+ result))
+
+(defun org-babel-scheme-execute-with-geiser (code output impl repl)
+ "Execute code in specified REPL. If the REPL doesn't exist, create it
+using the given scheme implementation.
+
+Returns the output of executing the code if the output parameter
+is true; otherwise returns the last value."
+ (let ((result nil))
+ (with-temp-buffer
+ (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
+ (newline)
+ (insert (if output
+ (format "(with-output-to-string (lambda () %s))" code)
+ code))
+ (geiser-mode)
+ (let ((repl-buffer (save-current-buffer
+ (org-babel-scheme-get-repl impl repl))))
+ (when (not (eq impl (org-babel-scheme-get-buffer-impl
+ (current-buffer))))
+ (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
+ (org-babel-scheme-get-buffer-impl (current-buffer))
+ (symbolp (org-babel-scheme-get-buffer-impl
+ (current-buffer)))))
+ (setq geiser-repl--repl repl-buffer)
+ (setq geiser-impl--implementation nil)
+ (geiser-eval-region (point-min) (point-max))
+ (setq result
+ (if (equal (substring (current-message) 0 3) "=> ")
+ (replace-regexp-in-string "^=> " "" (current-message))
+ "\"An error occurred.\""))
+ (when (not repl)
+ (save-current-buffer (set-buffer repl-buffer)
+ (geiser-repl-exit))
+ (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
+ (kill-buffer repl-buffer))
+ (setq result (if (or (string= result "#<void>")
+ (string= result "#<unspecified>"))
+ nil
+ (read result)))))
+ result))
+
(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)))))
+ (let* ((source-buffer (current-buffer))
+ (source-buffer-name (replace-regexp-in-string ;; zap surrounding *
+ "^ ?\\*\\([^*]+\\)\\*" "\\1"
+ (buffer-name source-buffer))))
+ (save-excursion
+ (org-babel-reassemble-table
+ (let* ((result-type (cdr (assoc :result-type params)))
+ (impl (or (when (cdr (assoc :scheme params))
+ (intern (cdr (assoc :scheme params))))
+ geiser-default-implementation
+ (car geiser-active-implementations)))
+ (session (org-babel-scheme-make-session-name
+ source-buffer-name (cdr (assoc :session params)) impl))
+ (full-body (org-babel-expand-body:scheme body params)))
+ (org-babel-scheme-execute-with-geiser
+ full-body ; code
+ (string= result-type "output") ; output?
+ impl ; implementation
+ (and (not (string= session "none")) session))) ; session
+ (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)))))))
(provide 'ob-scheme)
-
-
;;; ob-scheme.el ends here
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index 621110b2d4..f26337697a 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -34,7 +34,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
(defvar org-babel-screen-location "screen"
"The command location for screen.
diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el
index c0e6b15feb..ec1306b3b9 100644
--- a/lisp/org/ob-sh.el
+++ b/lisp/org/ob-sh.el
@@ -27,9 +27,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(require 'shell)
(eval-when-compile (require 'cl))
@@ -109,7 +106,7 @@ var of the same value."
"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)))
+ ((and (listp var) (or (listp (car var)) (equal (car var) 'hline)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
((listp var)
(mapconcat echo-var var "\n"))
@@ -141,10 +138,8 @@ 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
+ (org-babel-result-cond 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))))))
diff --git a/lisp/org/ob-shen.el b/lisp/org/ob-shen.el
index ec31546a0a..dc6313dc24 100644
--- a/lisp/org/ob-shen.el
+++ b/lisp/org/ob-shen.el
@@ -36,6 +36,7 @@
(require 'ob)
(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go))
+(declare-function org-babel-ruby-var-to-ruby "ob-ruby" (var))
(defvar org-babel-default-header-args:shen '()
"Default header arguments for shen code blocks.")
@@ -66,9 +67,8 @@ This function is called by `org-babel-execute-src-block'"
(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
+ (org-babel-result-cond result-params
+ results
(condition-case nil (org-babel-script-escape results)
(error results))))
(with-temp-buffer
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el
index 131fa46f14..658a54f1d8 100644
--- a/lisp/org/ob-sql.el
+++ b/lisp/org/ob-sql.el
@@ -32,12 +32,24 @@
;;
;; Also SQL evaluation generally takes place inside of a database.
;;
-;; For now lets just allow a generic ':cmdline' header argument.
+;; Header args used:
+;; - engine
+;; - cmdline
+;; - dbhost
+;; - dbuser
+;; - dbpassword
+;; - database
+;; - colnames (default, nil, means "yes")
+;; - result-params
+;; - out-file
+;; The following are used but not really implemented for SQL:
+;; - colname-names
+;; - rownames
+;; - rowname-names
;;
;; 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?
;;
@@ -52,30 +64,49 @@
(defvar org-babel-default-header-args:sql '())
-(defvar org-babel-header-args:sql
- '((engine . :any)
- (out-file . :any)))
+(defconst org-babel-header-args:sql
+ '((engine . :any)
+ (out-file . :any)
+ (dbhost . :any)
+ (dbuser . :any)
+ (dbpassword . :any)
+ (database . :any))
+ "SQL-specific header arguments.")
(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 dbstring-mysql (host user password database)
+ "Make MySQL cmd line args for database connection. Pass nil to omit that arg."
+ (combine-and-quote-strings
+ (remq nil
+ (list (when host (concat "-h" host))
+ (when user (concat "-u" user))
+ (when password (concat "-p" password))
+ (when database (concat "-D" database))))))
+
(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)))
+ (dbhost (cdr (assoc :dbhost params)))
+ (dbuser (cdr (assoc :dbuser params)))
+ (dbpassword (cdr (assoc :dbpassword params)))
+ (database (cdr (assoc :database params)))
(engine (cdr (assoc :engine params)))
+ (colnames-p (not (equal "no" (cdr (assoc :colnames 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"
+ ('dbi (format "dbish --batch %s < %s | sed '%s' > %s"
(or cmdline "")
(org-babel-process-file-name in-file)
- "/^+/d;s/^\|//;$d"
+ "/^+/d;s/^\|//;s/(NULL)/ /g;$d"
(org-babel-process-file-name out-file)))
('monetdb (format "mclient -f tab %s < %s > %s"
(or cmdline "")
@@ -85,7 +116,9 @@ This function is called by `org-babel-execute-src-block'."
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
- ('mysql (format "mysql %s < %s > %s"
+ ('mysql (format "mysql %s %s %s < %s > %s"
+ (dbstring-mysql dbhost dbuser dbpassword database)
+ (if colnames-p "" "-N")
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
@@ -102,28 +135,39 @@ This function is called by `org-babel-execute-src-block'."
(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
+ (org-babel-eval command "")
+ (org-babel-result-cond result-params
+ (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))
+ (cond
+ ((or (eq (intern engine) 'mysql)
+ (eq (intern engine) 'dbi)
+ (eq (intern engine) 'postgresql))
+ ;; Add header row delimiter after column-names header in first line
+ (cond
+ (colnames-p
+ (with-temp-buffer
+ (insert-file-contents out-file)
+ (goto-char (point-min))
+ (forward-line 1)
+ (insert "-\n")
+ (setq header-delim "-")
+ (write-file out-file)))))
+ (t
+ ;; Need to figure out the delimiter 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)
diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el
index c25e786fb6..84d4688ab3 100644
--- a/lisp/org/ob-sqlite.el
+++ b/lisp/org/ob-sqlite.el
@@ -27,8 +27,6 @@
;;; 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"
@@ -98,23 +96,21 @@ This function is called by `org-babel-execute-src-block'."
(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))))))
+ (org-babel-result-cond result-params
+ (buffer-string)
+ (if (equal (point-min) (point-max))
+ ""
+ (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."
@@ -147,7 +143,7 @@ This function is called by `org-babel-execute-src-block'."
(mapcar (lambda (row)
(if (equal 'hline row)
'hline
- (mapcar #'org-babel-read row))) result)))
+ (mapcar #'org-babel-string-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."
diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el
index 99951cab7b..8b3e36d735 100644
--- a/lisp/org/ob-table.el
+++ b/lisp/org/ob-table.el
@@ -50,7 +50,7 @@
;; #+TBLFM: $2='(sbe 'fibbd (n $1))
;;; Code:
-(require 'ob)
+(require 'ob-core)
(defun org-babel-table-truncate-at-newline (string)
"Replace newline character with ellipses.
@@ -97,9 +97,11 @@ as shown in the example below.
(lambda (el)
(if (eq '$ el)
(prog1 nil (setq quote t))
- (prog1 (if quote
- (format "\"%s\"" el)
- (org-no-properties el))
+ (prog1
+ (cond
+ (quote (format "\"%s\"" el))
+ ((stringp el) (org-no-properties el))
+ (t el))
(setq quote nil))))
(cdr var)))))
variables)))
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index c3b6a483ee..9f0e2de7f1 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -26,12 +26,14 @@
;; 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-edit-special "org" (&optional arg))
(declare-function org-link-escape "org" (text &optional table))
+(declare-function org-store-link "org" (arg))
+(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
(declare-function org-heading-components "org" ())
(declare-function org-back-to-heading "org" (invisible-ok))
(declare-function org-fill-template "org" (template alist))
@@ -112,7 +114,7 @@ result. The default value is `org-babel-trim'."
(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)
+ (find-file-noselect file 'nowarn)
(with-current-buffer (get-file-buffer file)
(revert-buffer t t t)))
@@ -137,68 +139,48 @@ evaluating BODY."
(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."
+used to limit the exported source code blocks by language.
+Return a list whose CAR is the tangled file name."
(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))))
+ (prog1
+ (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)
+(defun org-babel-tangle (&optional arg 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."
+file into their own source-specific files.
+With one universal prefix argument, only tangle the block at point.
+When two universal prefix arguments, only tangle blocks for the
+tangle file of the block at point.
+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
+ ;; 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)))
+ (when (equal arg '(4))
+ (let ((head (org-babel-where-is-src-block-head)))
+ (if head
+ (goto-char head)
+ (user-error "Point is not in a source code block"))))
(save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
@@ -206,6 +188,10 @@ exported source code blocks by language."
(org-babel-merge-params org-babel-default-header-args
(list (cons :tangle target-file)))
org-babel-default-header-args))
+ (tangle-file
+ (when (equal arg '(16))
+ (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light))))
+ (user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over all languages
(lambda (by-lang)
@@ -226,6 +212,7 @@ exported source code blocks by language."
(let* ((tangle (funcall get-spec :tangle))
(she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
(funcall get-spec :shebang)))
+ (tangle-mode (funcall get-spec :tangle-mode))
(base-name (cond
((string= "yes" tangle)
(file-name-sans-extension
@@ -243,7 +230,7 @@ exported source code blocks by language."
(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)))
+ (not (member file-name (mapcar #'car path-collector))))
(delete-file file-name))
;; drop source-block to file
(with-temp-buffer
@@ -261,24 +248,35 @@ exported source code blocks by language."
(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))
+ (when she-bang
+ (unless tangle-mode (setq tangle-mode #o755)))
;; update counter
(setq block-counter (+ 1 block-counter))
- (add-to-list 'path-collector file-name)))))
+ (add-to-list 'path-collector
+ (cons file-name tangle-mode)
+ nil
+ (lambda (a b) (equal (car a) (car b))))))))
specs)))
- (org-babel-tangle-collect-blocks lang))
+ (if (equal arg '(4))
+ (org-babel-tangle-single-block 1 t)
+ (org-babel-tangle-collect-blocks lang tangle-file)))
(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)))))
+ (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))))
+ (mapcar #'car path-collector)))
+ ;; set permissions on tangled files
+ (mapc (lambda (pair)
+ (when (cdr pair) (set-file-modes (car pair) (cdr pair))))
+ path-collector)
+ (mapcar #'car path-collector)))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
@@ -298,12 +296,12 @@ references."
(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)"
+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))
@@ -335,116 +333,137 @@ form
(insert
(format
"%s\n"
- (replace-regexp-in-string
- "^," ""
+ (org-unescape-code-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)
+(defvar org-comment-string) ;; Defined in org.el
+(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
"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)
+Optional argument LANGUAGE can be used to limit the collected
+source code blocks by language. Optional argument TANGLE-FILE
+can be used to limit the collected code blocks by target file."
+ (let ((block-counter 1) (current-heading "") blocks by-lang)
(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")
+ (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* ((info (org-babel-get-src-block-info 'light))
+ (src-lang (nth 0 info))
+ (src-tfile (cdr (assoc :tangle (nth 2 info)))))
+ (unless (or (string-match (concat "^" org-comment-string) current-heading)
+ (string= (cdr (assoc :tangle (nth 2 info))) "no")
+ (and tangle-file (not (equal tangle-file src-tfile))))
(unless (and language (not (string= language src-lang)))
- (let* ((info (org-babel-get-src-block-info))
- (params (nth 2 info))
- (extra (nth 3 info))
- (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
- (match-string 1 extra))
- org-coderef-label-format))
- (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)
- (when (string-match "-r" extra)
- (goto-char (point-min))
- (while (re-search-forward
- (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
- (replace-match "")))
- (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
+ ;; 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
+ (org-babel-tangle-single-block
+ block-counter)
+ by-lang)) blocks))))))
+ ;; Ensure blocks are in the correct order
(setq blocks
(mapcar
(lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang))))
blocks))
blocks))
+(defun org-babel-tangle-single-block
+ (block-counter &optional only-this-block)
+ "Collect the tangled source for current block.
+Return the list of block attributes needed by
+`org-babel-tangle-collect-blocks'.
+When ONLY-THIS-BLOCK is non-nil, return the full association
+list to be used by `org-babel-tangle' directly."
+ (let* ((info (org-babel-get-src-block-info))
+ (start-line
+ (save-restriction (widen)
+ (+ 1 (line-number-at-pos (point)))))
+ (file (buffer-file-name))
+ (src-lang (nth 0 info))
+ (params (nth 2 info))
+ (extra (nth 3 info))
+ (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
+ (match-string 1 extra))
+ org-coderef-label-format))
+ (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"
+ (or (ignore-errors (nth 4 (org-heading-components)))
+ "No 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)
+ (when (string-match "-r" extra)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
+ (replace-match "")))
+ (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)))))
+ (result
+ (list start-line file link source-name params body comment)))
+ (if only-this-block
+ (list (cons src-lang (list result)))
+ result)))
+
(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))
@@ -489,13 +508,15 @@ which enable the original code blocks to be found."
"Jump from a tangled code file to the related Org-mode file."
(interactive)
(let ((mid (point))
- start end done
+ start body-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 body-start (save-excursion
+ (forward-line 2) (point-at-bol)))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
@@ -516,8 +537,19 @@ which enable the original code blocks to be found."
(org-babel-next-src-block
(string-to-number (match-string 1 block-name)))
(org-babel-goto-named-src-block block-name))
+ ;; position at the beginning of the code block body
+ (goto-char (org-babel-where-is-src-block-head))
+ (forward-line 1)
+ ;; Use org-edit-special to isolate the code.
+ (org-edit-special)
+ ;; Then move forward the correct number of characters in the
+ ;; code buffer.
+ (forward-char (- mid body-start))
+ ;; And return to the Org-mode buffer with the point in the right
+ ;; place.
+ (org-edit-src-exit)
(setq target-char (point)))
- (pop-to-buffer target-buffer)
+ (org-src-switch-to-buffer target-buffer t)
(prog1 body (goto-char target-char))))
(provide 'ob-tangle)
diff --git a/lisp/org/ob.el b/lisp/org/ob.el
index 724571481f..827dd04a90 100644
--- a/lisp/org/ob.el
+++ b/lisp/org/ob.el
@@ -3,7 +3,6 @@
;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
;; Authors: Eric Schulte
-;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
@@ -23,2564 +22,17 @@
;; 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 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-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-remove-if "org" (predicate seq))
-(declare-function org-completing-read "org" (&rest args))
-(declare-function org-escape-code-in-region "org-src" (beg end))
-(declare-function org-unescape-code-in-string "org-src" (s))
-(declare-function org-table-to-lisp "org-table" (&optional txt))
-
-(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-unescape-code-in-string body))
- (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-unescape-code-in-string (org-no-properties (match-string 5)))
- (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)
- (goto-char end) (insert (concat finish "\n"))
- (goto-char beg) (insert (concat start "\n"))
- (org-escape-code-in-region (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"))
- ((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-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'."
- (let ((temporary-file-directory
- (if (file-remote-p default-directory)
- (concat (file-remote-p default-directory) "/tmp")
- (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)
+(require 'ob-eval)
+(require 'ob-core)
+(require 'ob-comint)
+(require 'ob-exp)
+(require 'ob-keys)
+(require 'ob-table)
+(require 'ob-lob)
+(require 'ob-ref)
+(require 'ob-tangle)
(provide 'ob)
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 764b15ff6c..fedbbe72ed 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -227,7 +227,9 @@ 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)
+ :type '(choice
+ (const nil)
+ (string)))
(defcustom org-agenda-persistent-filter nil
"When set, keep filters from one agenda view to the next."
@@ -242,6 +244,11 @@ you can \"misuse\" it to also add other text to the header."
(defconst org-sorting-choice
'(choice
(const time-up) (const time-down)
+ (const timestamp-up) (const timestamp-down)
+ (const scheduled-up) (const scheduled-down)
+ (const deadline-up) (const deadline-down)
+ (const ts-up) (const ts-down)
+ (const tsia-up) (const tsia-down)
(const category-keep) (const category-up) (const category-down)
(const tag-down) (const tag-up)
(const priority-up) (const priority-down)
@@ -254,9 +261,50 @@ you can \"misuse\" it to also add other text to the header."
;; 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))
+(org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+(org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
+
+(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.
+
+ :deadline* Same as above, but only include the deadline if it has an
+ hour specification as [h]h:mm.
+
+ :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.
+
+ :scheduled* Same as above, but only include the scheduled item if it
+ has an hour specification as [h]h:mm.
+
+By default, all four non-starred types are turned on.
+
+When :scheduled* or :deadline* are included, :schedule or :deadline
+will be ignored.
+
+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'.")
(defconst org-agenda-custom-commands-local-options
`(repeat :tag "Local settings for this command. Remember to quote values"
@@ -282,6 +330,7 @@ you can \"misuse\" it to also add other text to the header."
(const org-agenda-span)
(choice (const :tag "Day" 'day)
(const :tag "Week" 'week)
+ (const :tag "Fortnight" 'fortnight)
(const :tag "Month" 'month)
(const :tag "Year" 'year)
(integer :tag "Custom")))
@@ -311,13 +360,21 @@ you can \"misuse\" it to also add other text to the header."
(const :format "" quote)
(repeat
(string :tag "+tag or -tag"))))
+ (list :tag "Regexp filter preset"
+ (const org-agenda-regexp-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+regexp or -regexp"))))
(list :tag "Set daily/weekly entry types"
(const org-agenda-entry-types)
(list
(const :format "" quote)
- (set :greedy t :value (:deadline :scheduled :timestamp :sexp)
+ (set :greedy t :value ,org-agenda-entry-types
(const :deadline)
(const :scheduled)
+ (const :deadline*)
+ (const :scheduled*)
(const :timestamp)
(const :sexp))))
(list :tag "Standard skipping condition"
@@ -371,8 +428,8 @@ 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))))
+(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:
@@ -603,6 +660,13 @@ 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-restriction-lock-highlight-subtree t
+ "Non-nil means highlight the whole subtree when restriction is active.
+Otherwise only highlight the headline. Highlighting the whole subtree is
+useful to ensure no edits happen beyond the restricted region."
+ :group 'org-agenda
+ :type 'boolean)
+
(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."
@@ -740,8 +804,24 @@ to make his option also apply to the tags-todo list."
(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-todo-ignore-time-comparison-use-seconds nil
+ "Time unit to use when possibly ignoring an agenda item.
+
+See the docstring of various `org-agenda-todo-ignore-*' options.
+The default is to compare time stamps using days. An item is thus
+considered to be in the future if it is at least one day after today.
+Non-nil means to compare time stamps using seconds. An item is then
+considered future if it has a time value later than current time."
+ :group 'org-agenda-skip
+ :group 'org-agenda-todo-list
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Compare time with days" nil)
+ (const :tag "Compare time with seconds" t)))
+
(defcustom org-agenda-tags-todo-honor-ignore-options nil
- "Non-nil means honor todo-list ...ignore options also in tags-todo search.
+ "Non-nil means honor todo-list ignores options also in tags-todo search.
The variables
`org-agenda-todo-ignore-with-date',
`org-agenda-todo-ignore-timestamp',
@@ -768,20 +848,29 @@ is DONE."
(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."
+
+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 nil, the entry will be shown several times.
+
+When set to t, then only the deadline is shown and the fact that
+the entry is scheduled today or was scheduled previously is not
+shown.
+
+When set to the symbol `not-today', skip scheduled previously,
+but not scheduled today.
+
+When set to the symbol `repeated-after-deadline', skip scheduled
+items if they are repeated beyond the current dealine."
: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)))
+ (const :tag "Not when scheduled today" not-today)
+ (const :tag "When repeated past deadline" repeated-after-deadline)))
(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
"Non-nil means skip timestamp line if same entry shows because of deadline.
@@ -813,9 +902,10 @@ deadlines are always turned off when the item is DONE."
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 variable may be set to nil, t, the symbol `pre-scheduled',
+or a number which will then give the number of days before the actual
+deadline when the prewarnings should resume. The symbol `pre-scheduled'
+eliminates the deadline prewarning only prior to the scheduled date.
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."
@@ -824,9 +914,26 @@ because you will take care of it on the day when scheduled."
:version "24.1"
:type '(choice
(const :tag "Always show prewarning" nil)
+ (const :tag "Remove prewarning prior to scheduled date" pre-scheduled)
(const :tag "Remove prewarning if entry is scheduled" t)
(integer :tag "Restart prewarning N days before deadline")))
+(defcustom org-agenda-skip-scheduled-delay-if-deadline nil
+ "Non-nil means skip scheduled delay when entry also has a deadline.
+This variable may be set to nil, t, the symbol `post-deadline',
+or a number which will then give the number of days after the actual
+scheduled date when the delay should expire. The symbol `post-deadline'
+eliminates the schedule delay when the date is posterior to the deadline."
+ :group 'org-agenda-skip
+ :group 'org-agenda-daily/weekly
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Always honor delay" nil)
+ (const :tag "Ignore delay if posterior to the deadline" post-deadline)
+ (const :tag "Ignore delay if entry has a deadline" t)
+ (integer :tag "Honor delay up until N days after the scheduled date")))
+
(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
@@ -840,7 +947,7 @@ entry, the rest of the entry will not be searched."
:group 'org-agenda-daily/weekly
:type 'boolean)
-(defcustom org-agenda-dim-blocked-tasks nil
+(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',
@@ -956,6 +1063,13 @@ removed from entry text before it is shown in the agenda."
:group 'org-agenda
:type '(repeat (regexp)))
+(defcustom org-agenda-entry-text-leaders " > "
+ "Text prepended to the entry text in agenda buffers."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda
+ :type 'string)
+
(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
@@ -1013,7 +1127,8 @@ option will be ignored."
Should be 1 or 7.
Obsolete, see `org-agenda-span'."
:group 'org-agenda-daily/weekly
- :type 'integer)
+ :type '(choice (const nil)
+ (integer)))
(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
@@ -1024,13 +1139,14 @@ 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 "Fortnight" fortnight)
(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.
+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
@@ -1055,7 +1171,7 @@ a calendar-style date list like (month day year)."
(function :tag "Function")))
(defun org-agenda-format-date-aligned (date)
- "Format a date string for display in the daily/weekly agenda, or timeline.
+ "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))
@@ -1108,8 +1224,7 @@ For example, 9:30am would become 09:30 rather than 9:30."
":" 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'"
+ "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))
@@ -1164,7 +1279,7 @@ shown, either today or the nearest into the future."
(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.
+ "Number of days to continue listing scheduled items 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."
@@ -1294,9 +1409,8 @@ boolean search."
:version "24.1"
:type 'boolean)
-(if (fboundp 'defvaralias)
- (defvaralias 'org-agenda-search-view-search-words-only
- 'org-agenda-search-view-always-boolean))
+(org-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.
@@ -1305,6 +1419,15 @@ When nil, they may also match part of a word."
:version "24.1"
:type 'boolean)
+(defcustom org-agenda-search-view-max-outline-level nil
+ "Maximum outline level to display in search view.
+E.g. when this is set to 1, the search view will only
+show headlines of level 1."
+ :group 'org-agenda-search-view
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
(defgroup org-agenda-time-grid nil
"Options concerning the time grid in the Org-mode Agenda."
:tag "Org Agenda Time Grid"
@@ -1393,6 +1516,16 @@ 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
+timestamp-up Sort by any timestamp, early first
+timestamp-down Sort by any timestamp, late first
+scheduled-up Sort by scheduled timestamp, early first
+scheduled-down Sort by scheduled timestamp, late first
+deadline-up Sort by deadline timestamp, early first
+deadline-down Sort by deadline timestamp, late first
+ts-up Sort by active timestamp, early first
+ts-down Sort by active timestamp, late first
+tsia-up Sort by inactive timestamp, early first
+tsia-down Sort by inactive timestamp, 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.
@@ -1493,15 +1626,17 @@ 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
+ %l the level of the item (insert X space(s) if item is of level X)
%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
+ %b show breadcrumbs, i.e., the names of the higher levels
%(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 `%'
+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
@@ -1511,11 +1646,11 @@ 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.
+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 is empty, no additional colon is inserted.
The default value for the agenda sublist is \" %-12:c%?-12t% s\",
which means:
@@ -1588,6 +1723,8 @@ 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
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type '(list
(string :tag "Scheduled today ")
(string :tag "Scheduled previously")))
@@ -1597,17 +1734,17 @@ that passed since this item was scheduled first."
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")))
+ :type 'string)
-(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ")
+(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ")
"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)."
+This is a list with three strings. The first applies when the item has its
+deadline on the current day. The second applies when the deadline is in the
+future, the third one when it is in the past. The strings may contain %d
+to capture the number of days."
:group 'org-agenda-line-format
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type '(list
(string :tag "Deadline today ")
(choice :tag "Deadline relative"
@@ -1716,9 +1853,8 @@ When this is the symbol `prefix', only remove tags when
(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))
+(org-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.
@@ -1728,8 +1864,7 @@ it means that the tags should be flushright to that column. For example,
:group 'org-agenda-line-format
:type 'integer)
-(if (fboundp 'defvaralias)
- (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column))
+(org-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.
@@ -1762,7 +1897,7 @@ 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)
+ :type '(choice (const nil) (function)))
(defcustom org-agenda-category-icon-alist nil
"Alist of category icon to be displayed in agenda views.
@@ -1844,7 +1979,7 @@ 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)
+ :type '(choice (const nil) (function)))
(defcustom org-agenda-bulk-custom-functions nil
"Alist of characters and custom functions for bulk actions.
@@ -1887,8 +2022,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
(defvar org-agenda-mode-map (make-sparse-keymap)
"Keymap for `org-agenda-mode'.")
-(if (fboundp 'defvaralias)
- (defvaralias 'org-agenda-keymap 'org-agenda-mode-map))
+(org-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.
@@ -1956,12 +2090,14 @@ When nil, `q' will kill the single agenda buffer."
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-overlays
org-agenda-tag-filter
+ org-agenda-cat-filter-overlays
org-agenda-category-filter
+ org-agenda-re-filter-overlays
+ org-agenda-regexp-filter
org-agenda-markers
org-agenda-last-search-view-search-was-boolean
org-agenda-filtered-by-category
@@ -2015,10 +2151,10 @@ The following commands are available:
(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
- (add-hook 'filter-buffer-substring-functions
- (lambda (fun start end delete)
- (substring-no-properties (funcall fun start end delete)))
- nil t)
+ (org-add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (substring-no-properties (funcall fun start end delete)))
+ nil t)
(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
@@ -2049,8 +2185,12 @@ The following commands are available:
(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 [(meta down)] 'org-agenda-drag-line-forward)
+(org-defkey org-agenda-mode-map [(meta up)] 'org-agenda-drag-line-backward)
(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark)
+(org-defkey org-agenda-mode-map "\M-m" 'org-agenda-bulk-toggle)
(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all)
+(org-defkey org-agenda-mode-map "\M-*" 'org-agenda-bulk-toggle-all)
(org-defkey org-agenda-mode-map "#" 'org-agenda-dim-blocked-tasks)
(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp)
(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark)
@@ -2164,9 +2304,12 @@ The following commands are available:
(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-regexp)
+(org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all)
(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
+(org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively)
(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-agenda-filter-by-top-headline)
(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)
@@ -2194,7 +2337,11 @@ The following commands are available:
["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)"]
+ :keys "v w"]
+ ["Fortnight View" org-agenda-fortnight-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'fortnight)
+ :keys "v f"]
["Month View" org-agenda-month-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'month)
@@ -2263,9 +2410,11 @@ The following commands are available:
("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"])
+ ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"]
+ ["Toggle mark" org-agenda-bulk-toggle t]
+ ["Toggle all" org-agenda-bulk-toggle-all t]
+ ["Mark regexp" org-agenda-bulk-mark-regexp t])
["Act on all marked" org-agenda-bulk-action t]
"--"
("Tags and Properties"
@@ -2307,7 +2456,7 @@ The following commands are available:
["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])
+ ["Create iCalendar File" org-icalendar-combine-agenda-files t])
"--"
["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
"--"
@@ -2336,12 +2485,12 @@ 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"))
+ (user-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"))
+ (user-error "No further undo information"))
(let* ((entry (pop org-agenda-pending-undo-list))
buf line cmd rembuf)
(setq cmd (pop entry) line (pop entry))
@@ -2392,6 +2541,8 @@ Here are the available contexts definitions:
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
+ in-buffer: command displayed only in matching buffers
+not-in-buffer: command not displayed in matching buffers
[function]: a custom function taking no argument
If you define several checks, the agenda command will be
@@ -2417,11 +2568,89 @@ duplicates.)"
(choice
(const :tag "In file" in-file)
(const :tag "Not in file" not-in-file)
+ (const :tag "In buffer" in-buffer)
+ (const :tag "Not in buffer" not-in-buffer)
(const :tag "In mode" in-mode)
(const :tag "Not in mode" not-in-mode))
(regexp))
(function :tag "Custom function"))))))
+(defcustom org-agenda-max-entries nil
+ "Maximum number of entries to display in an agenda.
+This can be nil (no limit) or an integer or an alist of agenda
+types with an associated number of entries to display in this
+type."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda-custom-commands
+ :type '(choice (symbol :tag "No limit" nil)
+ (integer :tag "Max number of entries")
+ (repeat
+ (cons (choice :tag "Agenda type"
+ (const agenda)
+ (const todo)
+ (const tags)
+ (const search)
+ (const timeline))
+ (integer :tag "Max number of entries")))))
+
+(defcustom org-agenda-max-todos nil
+ "Maximum number of TODOs to display in an agenda.
+This can be nil (no limit) or an integer or an alist of agenda
+types with an associated number of entries to display in this
+type."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda-custom-commands
+ :type '(choice (symbol :tag "No limit" nil)
+ (integer :tag "Max number of entries")
+ (repeat
+ (cons (choice :tag "Agenda type"
+ (const agenda)
+ (const todo)
+ (const tags)
+ (const search)
+ (const timeline))
+ (integer :tag "Max number of entries")))))
+
+(defcustom org-agenda-max-tags nil
+ "Maximum number of tagged entries to display in an agenda.
+This can be nil (no limit) or an integer or an alist of agenda
+types with an associated number of entries to display in this
+type."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda-custom-commands
+ :type '(choice (symbol :tag "No limit" nil)
+ (integer :tag "Max number of entries")
+ (repeat
+ (cons (choice :tag "Agenda type"
+ (const agenda)
+ (const todo)
+ (const tags)
+ (const search)
+ (const timeline))
+ (integer :tag "Max number of entries")))))
+
+(defcustom org-agenda-max-effort nil
+ "Maximum cumulated effort duration for the agenda.
+This can be nil (no limit) or a number of minutes (as an integer)
+or an alist of agenda types with an associated number of minutes
+to limit entries to in this type."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda-custom-commands
+ :type '(choice (symbol :tag "No limit" nil)
+ (integer :tag "Max number of entries")
+ (repeat
+ (cons (choice :tag "Agenda type"
+ (const agenda)
+ (const todo)
+ (const tags)
+ (const search)
+ (const timeline))
+ (integer :tag "Max number of entries")))))
+
(defvar org-keys nil)
(defvar org-match nil)
;;;###autoload
@@ -2515,12 +2744,12 @@ Pressing `<' twice means to restrict to the current subtree or region
(put 'org-agenda-files 'org-restrict (list bfn))
(cond
((eq restriction 'region)
- (setq org-agenda-restrict t)
+ (setq org-agenda-restrict (current-buffer))
(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)
+ (setq org-agenda-restrict (current-buffer))
(org-back-to-heading t)
(move-marker org-agenda-restrict-begin (point))
(move-marker org-agenda-restrict-end
@@ -2541,6 +2770,8 @@ Pressing `<' twice means to restrict to the current subtree or region
(cond
((eq type 'agenda)
(org-let lprops '(org-agenda-list current-prefix-arg)))
+ ((eq type 'agenda*)
+ (org-let lprops '(org-agenda-list current-prefix-arg nil nil t)))
((eq type 'alltodo)
(org-let lprops '(org-todo-list current-prefix-arg)))
((eq type 'search)
@@ -2569,7 +2800,7 @@ Pressing `<' twice means to restrict to the current subtree or region
(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))))
+ (t (user-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)
@@ -2600,14 +2831,14 @@ Pressing `<' twice means to restrict to the current subtree or region
t t))
((equal org-keys "L")
(unless (derived-mode-p 'org-mode)
- (error "This is not an Org-mode file"))
+ (user-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"))))))
+ (t (user-error "Invalid agenda key"))))))
(defun org-agenda-append-agenda ()
"Append another agenda view to the current one.
@@ -2615,14 +2846,16 @@ 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"))
+ (user-error "Can only append from within agenda buffer"))
(let ((org-agenda-multi t))
(org-agenda)
(widen)
(org-agenda-finalize)
+ (setq buffer-read-only t)
(org-agenda-fit-window-to-buffer)))
(defun org-agenda-normalize-custom-commands (cmds)
+ "Normalize custom commands CMDS."
(delq nil
(mapcar
(lambda (x)
@@ -2697,6 +2930,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
(cond
((string-match "\\S-" desc) desc)
((eq type 'agenda) "Agenda for current week or day")
+ ((eq type 'agenda*) "Appointments 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")
@@ -2820,7 +3054,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
(org-agenda-get-restriction-and-command prefix-descriptions))
((equal c ?q) (error "Abort"))
- (t (error "Invalid key %c" c))))))))
+ (t (user-error "Invalid key %c" c))))))))
(defun org-agenda-fit-window-to-buffer ()
"Fit the window to the buffer size."
@@ -2836,6 +3070,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
(defvar org-agenda-overriding-arguments nil)
(defvar org-agenda-overriding-cmd-arguments nil)
(defun org-agenda-run-series (name series)
+ "Run agenda NAME as a SERIES of agenda commands."
(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.
@@ -2858,6 +3093,9 @@ L Timeline for current buffer # List stuck projects (!=configure)
((eq type 'agenda)
(org-let2 gprops lprops
'(call-interactively 'org-agenda-list)))
+ ((eq type 'agenda*)
+ (org-let2 gprops lprops
+ '(funcall 'org-agenda-list nil nil t)))
((eq type 'alltodo)
(org-let2 gprops lprops
'(call-interactively 'org-todo-list)))
@@ -2898,9 +3136,10 @@ 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)))
+ (let (org-agenda-sticky)
+ (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)))
@@ -3005,6 +3244,7 @@ This ensures the export commands can easily use it."
;;;###autoload
(defun org-store-agenda-views (&rest parameters)
+ "Store agenda views."
(interactive)
(eval (list 'org-batch-store-agenda-views)))
@@ -3060,10 +3300,12 @@ This ensures the export commands can easily use it."
(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.
+HTML (.html or .htm), PDF (.pdf) 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.
+If the extension is .org, collect all subtrees corresponding to the
+agenda entries and add them in an .org file.
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
@@ -3071,13 +3313,16 @@ 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))
+ (if (or (not (file-writable-p file))
+ (and (file-exists-p file)
+ (if (org-called-interactively-p 'any)
+ (not (y-or-n-p (format "Overwrite existing file %s? " file))))))
+ (user-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)
+ (let ((bs (copy-sequence (buffer-string))) beg content)
(org-agenda-unmark-filtered-text)
(with-temp-buffer
(rename-buffer org-agenda-write-buffer-name t)
@@ -3093,6 +3338,25 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(cond
((org-bound-and-true-p org-mobile-creating-agendas)
(org-mobile-write-agenda-for-mobile file))
+ ((string-match "\\.org\\'" file)
+ (let (content p m message-log-max)
+ (goto-char (point-min))
+ (while (setq p (next-single-property-change (point) 'org-hd-marker nil))
+ (goto-char p)
+ (setq m (get-text-property (point) 'org-hd-marker))
+ (when m
+ (push (save-excursion
+ (set-buffer (marker-buffer m))
+ (goto-char m)
+ (org-copy-subtree 1 nil t t)
+ org-subtree-clip)
+ content)))
+ (find-file file)
+ (erase-buffer)
+ (mapcar (lambda (s) (org-paste-subtree 1 s)) (reverse content))
+ (write-file file)
+ (kill-buffer (current-buffer))
+ (message "Org file written to %s" file)))
((string-match "\\.html?\\'" file)
(require 'htmlize)
(set-buffer (htmlize-buffer (current-buffer)))
@@ -3120,14 +3384,8 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(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))))
+ (require 'ox-icalendar)
+ (org-icalendar-export-current-agenda (expand-file-name file)))
(t
(let ((bs (buffer-string)))
(find-file file)
@@ -3143,6 +3401,7 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(defvar org-agenda-tag-filter-overlays nil)
(defvar org-agenda-cat-filter-overlays nil)
+(defvar org-agenda-re-filter-overlays nil)
(defun org-agenda-mark-filtered-text ()
"Mark all text hidden by filtering with a text property."
@@ -3154,7 +3413,8 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(overlay-start o) (overlay-end o)
'org-filtered t)))
(append org-agenda-tag-filter-overlays
- org-agenda-cat-filter-overlays))))
+ org-agenda-cat-filter-overlays
+ org-agenda-re-filter-overlays))))
(defun org-agenda-unmark-filtered-text ()
"Remove the filtering text property."
@@ -3278,43 +3538,6 @@ removed from the entry content. Currently only `planning' is allowed here."
(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)
@@ -3329,7 +3552,8 @@ removed from the entry content. Currently only `planning' is allowed here."
(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-regexp-filter nil)
+(defvar org-agenda-top-headline-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.
@@ -3351,6 +3575,15 @@ 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-regexp-filter-preset nil
+ "A preset of the regexp 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
@@ -3409,11 +3642,14 @@ generating a new one."
(setq org-drawers-for-agenda nil)
(unless org-agenda-persistent-filter
(setq org-agenda-tag-filter nil
- org-agenda-category-filter nil))
+ org-agenda-category-filter nil
+ org-agenda-regexp-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)
+ (put 'org-agenda-regexp-filter :preset-filter
+ org-agenda-regexp-filter-preset)
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
@@ -3516,14 +3752,13 @@ generating a new one."
(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))
+ (when (or org-agenda-regexp-filter (get 'org-agenda-regexp-filter :preset-filter))
+ (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
(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)))
+ (org-agenda-unmark-clocking-task)
(when (marker-buffer org-clock-hd-marker)
(save-excursion
(goto-char (point-min))
@@ -3538,6 +3773,13 @@ generating a new one."
(overlay-put ov 'help-echo
"The clock is running in this item")))))))
+(defun org-agenda-unmark-clocking-task ()
+ "Unmark the current clocking task."
+ (mapc (lambda (o)
+ (if (eq (overlay-get o 'type) 'org-agenda-clocking)
+ (delete-overlay o)))
+ (overlays-in (point-min) (point-max))))
+
(defun org-agenda-fontify-priorities ()
"Make highest priority lines bold, and lowest italic."
(interactive)
@@ -3545,8 +3787,7 @@ generating a new one."
(delete-overlay o)))
(overlays-in (point-min) (point-max)))
(save-excursion
- (let ((inhibit-read-only t)
- b e p ov h l)
+ (let (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)
@@ -3561,21 +3802,25 @@ generating a new one."
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)))
+ (cons (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))
+ 'org-priority))
(overlay-put ov 'org-type 'org-priority)))))
(defun org-agenda-dim-blocked-tasks (&optional invisible)
+ "Dim currently blocked TODO's in the agenda display.
+When INVISIBLE is non-nil, hide currently blocked TODO instead of
+dimming them."
(interactive "P")
- "Dim currently blocked TODO's in the agenda display."
- (message "Dim or hide blocked tasks...")
+ (when (org-called-interactively-p 'interactive)
+ (message "Dim or hide blocked tasks..."))
(mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo)
(delete-overlay o)))
(overlays-in (point-min) (point-max)))
@@ -3605,7 +3850,8 @@ generating a new one."
(overlay-put ov 'invisible t)
(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
(overlay-put ov 'org-type 'org-blocked-todo))))))
- (message "Dim or hide blocked tasks...done"))
+ (when (org-called-interactively-p 'interactive)
+ (message "Dim or hide blocked tasks...done")))
(defvar org-agenda-skip-function nil
"Function to be called at each match during agenda construction.
@@ -3640,7 +3886,7 @@ continue from there."
(throw :skip t))))
(defun org-agenda-skip-eval (form)
- "If FORM is a function or a list, call (or eval) is and return result.
+ "If FORM is a function or a list, call (or eval) it and return the 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."
@@ -3695,7 +3941,8 @@ This check for agenda markers in all agenda buffers currently active."
(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 " > "))))
+ m org-agenda-entry-text-maxlines
+ org-agenda-entry-text-leaders))))
(when (string-match "\\S-" txt)
(setq o (make-overlay (point-at-bol) (point-at-eol)))
(overlay-put o 'evaporate t)
@@ -3746,6 +3993,7 @@ dates."
(interactive "P")
(let* ((dopast t)
(org-agenda-show-log-scoped org-agenda-show-log)
+ (org-agenda-show-log org-agenda-show-log-scoped)
(entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
(current-buffer))))
(date (calendar-current-date))
@@ -3762,9 +4010,11 @@ dates."
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))))
+ (list 'let
+ (list (list 'org-agenda-show-log 'org-agenda-show-log))
+ (list 'org-switch-to-buffer-other-window (current-buffer))
+ (list 'org-timeline (list 'quote dotodo))))
+ (put 'org-agenda-redo-command 'org-lprops nil)
(if (not dopast)
;; Remove past dates from the list of dates.
(setq day-numbers (delq nil (mapcar (lambda(x)
@@ -3815,12 +4065,13 @@ dates."
(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"))
+ (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\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))
+ (add-text-properties
+ (point-min) (point-max)
+ `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command))
(org-agenda-finalize)
(setq buffer-read-only t)))
@@ -3874,46 +4125,16 @@ When EMPTY is non-nil, also include days without any entries."
(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.")
+Custom commands can set this variable in the options section.
+This is usually a string like \"2007-11-01\", \"+2d\" or any other
+input allowed when reading a date through the Org calendar.
+See the docstring of `org-read-date' for details.")
(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)
+(defun org-agenda-list (&optional arg start-day span with-hour)
"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.
@@ -3923,7 +4144,10 @@ 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'."
+given in `org-agenda-start-on-weekday'.
+
+When WITH-HOUR is non-nil, only include scheduled and deadline
+items if they have an hour specification like [h]h:mm."
(interactive "P")
(if org-agenda-overriding-arguments
(setq arg (car org-agenda-overriding-arguments)
@@ -3954,7 +4178,7 @@ given in `org-agenda-start-on-weekday'."
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
(org-agenda-start-on-weekday
- (if (eq ndays 7)
+ (if (or (eq ndays 7) (eq ndays 14))
org-agenda-start-on-weekday))
(thefiles (org-agenda-files nil 'ifmode))
(files thefiles)
@@ -3973,7 +4197,7 @@ given in `org-agenda-start-on-weekday'."
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)))
+ (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
(dotimes (n (1- ndays))
(push (1+ (car day-numbers)) day-numbers))
(setq day-numbers (nreverse day-numbers))
@@ -4016,9 +4240,26 @@ given in `org-agenda-start-on-weekday'."
(catch 'nextfile
(org-check-agenda-file file)
(let ((org-agenda-entry-types org-agenda-entry-types))
- (unless org-agenda-include-deadlines
+ ;; Starred types override non-starred equivalents
+ (when (member :deadline* org-agenda-entry-types)
(setq org-agenda-entry-types
(delq :deadline org-agenda-entry-types)))
+ (when (member :scheduled* org-agenda-entry-types)
+ (setq org-agenda-entry-types
+ (delq :scheduled org-agenda-entry-types)))
+ ;; Honor with-hour
+ (when with-hour
+ (when (member :deadline org-agenda-entry-types)
+ (setq org-agenda-entry-types
+ (delq :deadline org-agenda-entry-types))
+ (push :deadline* org-agenda-entry-types))
+ (when (member :scheduled org-agenda-entry-types)
+ (setq org-agenda-entry-types
+ (delq :scheduled org-agenda-entry-types))
+ (push :scheduled* org-agenda-entry-types)))
+ (unless org-agenda-include-deadlines
+ (setq org-agenda-entry-types
+ (delq :deadline* (delq :deadline org-agenda-entry-types))))
(cond
((memq org-agenda-show-log-scoped '(only clockcheck))
(setq rtn (org-agenda-get-day-entries
@@ -4056,7 +4297,7 @@ given in `org-agenda-start-on-weekday'."
(setq rtnall
(org-agenda-add-time-grid-maybe rtnall ndays todayp))
(if rtnall (insert ;; all entries
- (org-agenda-finalize-entries rtnall)
+ (org-agenda-finalize-entries rtnall 'agenda)
"\n"))
(put-text-property s (1- (point)) 'day d)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
@@ -4106,13 +4347,16 @@ given in `org-agenda-start-on-weekday'."
(cond ((symbolp n) n)
((= n 1) 'day)
((= n 7) 'week)
+ ((= n 14) 'fortnight)
(t n)))
(defun org-agenda-span-to-ndays (span &optional start-day)
- "Return ndays from SPAN, possibly starting at START-DAY."
+ "Return ndays from SPAN, possibly starting at START-DAY.
+START-DAY is an absolute time value."
(cond ((numberp span) span)
((eq span 'day) 1)
((eq span 'week) 7)
+ ((eq span 'fortnight) 14)
((eq span 'month)
(let ((date (calendar-gregorian-from-absolute start-day)))
(calendar-last-day-of-month (car date) (caddr date))))
@@ -4206,7 +4450,7 @@ in `org-agenda-text-search-extra-files'."
(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 inherited-tags
- marker category category-pos tags c neg re boolean
+ marker category category-pos level tags c neg re boolean
ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
(unless (and (not edit-at)
(stringp string)
@@ -4323,7 +4567,7 @@ in `org-agenda-text-search-extra-files'."
(let ((case-fold-search t))
(save-excursion
(save-restriction
- (if org-agenda-restrict
+ (if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
@@ -4334,10 +4578,23 @@ in `org-agenda-text-search-extra-files'."
(goto-char (max (point-min) (1- (point))))
(while (re-search-forward regexp nil t)
(org-back-to-heading t)
+ (while (and org-agenda-search-view-max-outline-level
+ (> (org-reduced-level (org-outline-level))
+ org-agenda-search-view-max-outline-level)
+ (forward-line -1)
+ (outline-back-to-heading t)))
(skip-chars-forward "* ")
(setq beg (point-at-bol)
beg1 (point)
- end (progn (outline-next-heading) (point)))
+ end (progn
+ (outline-next-heading)
+ (while (and org-agenda-search-view-max-outline-level
+ (> (org-reduced-level (org-outline-level))
+ org-agenda-search-view-max-outline-level)
+ (forward-line 1)
+ (outline-next-heading)))
+ (point)))
+
(catch :skip
(goto-char beg)
(org-agenda-skip)
@@ -4358,6 +4615,7 @@ in `org-agenda-text-search-extra-files'."
(goto-char beg)
(setq marker (org-agenda-new-marker (point))
category (org-get-category)
+ level (make-string (org-reduced-level (org-outline-level)) ? )
category-pos (get-text-property (point) 'org-category-position)
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
@@ -4371,10 +4629,11 @@ in `org-agenda-text-search-extra-files'."
""
(buffer-substring-no-properties
beg1 (point-at-eol))
- category tags t))
+ level category tags t))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'org-todo-regexp org-todo-regexp
+ 'level level
'org-complex-heading-regexp org-complex-heading-regexp
'priority 1000 'org-category category
'org-category-position category-pos
@@ -4399,7 +4658,7 @@ in `org-agenda-text-search-extra-files'."
(list 'face 'org-agenda-structure))))
(org-agenda-mark-header-line (point-min))
(when rtnall
- (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (insert (org-agenda-finalize-entries rtnall 'search) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
@@ -4412,6 +4671,18 @@ in `org-agenda-text-search-extra-files'."
;;; Agenda TODO list
+(defun org-agenda-propertize-selected-todo-keywords (keywords)
+ "Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
+ (concat
+ (if (or (equal keywords "ALL") (not keywords))
+ (propertize "ALL" 'face 'warning)
+ (mapconcat
+ (lambda (kw)
+ (propertize kw 'face (org-get-todo-face kw)))
+ (org-split-string keywords "|")
+ "|"))
+ "\n"))
+
(defvar org-select-this-todo-keyword nil)
(defvar org-last-arg nil)
@@ -4472,9 +4743,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(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))
+ (insert (org-agenda-propertize-selected-todo-keywords
+ org-select-this-todo-keyword))
(setq pos (point))
(unless org-agenda-multi
(insert "Available with `N r': (0)[ALL]")
@@ -4489,7 +4759,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(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"))
+ (insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
@@ -4517,8 +4787,6 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
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
@@ -4526,7 +4794,11 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(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")))))
+ ;; Prepare agendas (and `org-tag-alist-for-agenda') before
+ ;; expanding tags within `org-make-tags-matcher'
(org-agenda-prepare (concat "TAGS " match))
+ (setq matcher (org-make-tags-matcher match)
+ match (car matcher) matcher (cdr matcher))
(org-compile-prefix-format 'tags)
(org-set-sorting-strategy 'tags)
(setq org-agenda-query-string match)
@@ -4551,7 +4823,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(error "Agenda file %s is not in `org-mode'" file))
(save-excursion
(save-restriction
- (if org-agenda-restrict
+ (if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
@@ -4574,7 +4846,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(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"))
+ (insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
@@ -4863,7 +5135,7 @@ of what a project is and how to check if it stuck, customize the variable
(setq entries
(mapcar
(lambda (x)
- (setq x (org-agenda-format-item "" x "Diary" nil 'time))
+ (setq x (org-agenda-format-item "" x nil "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))
@@ -4953,8 +5225,8 @@ 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.
+If you don't give any arguments (as in the example above), the default value
+of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
So the example above may also be written as
&%%(org-diary :deadline :timestamp :sexp :scheduled)
@@ -4970,7 +5242,7 @@ function from a program - use `org-agenda-get-day-entries' instead."
(org-agenda-reset-markers))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
- (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
+ (setq args (or args org-agenda-entry-types))
(let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
(list entry)
(org-agenda-files t)))
@@ -4988,8 +5260,11 @@ function from a program - use `org-agenda-get-day-entries' instead."
(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"))))
+ (when results
+ (setq results
+ (mapcar (lambda (i) (replace-regexp-in-string
+ org-bracket-link-regexp "\\3" i)) results))
+ (concat (org-agenda-finalize-entries results) "\n"))))
;;; Agenda entry finders
@@ -4999,7 +5274,7 @@ 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)))
+ (setq args (or args org-agenda-entry-types))
(let* ((org-startup-folded nil)
(org-startup-align-all-tables nil)
(buffer (if (file-exists-p file)
@@ -5016,7 +5291,7 @@ the documentation of `org-diary'."
(let ((case-fold-search nil))
(save-excursion
(save-restriction
- (if org-agenda-restrict
+ (if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
@@ -5039,16 +5314,29 @@ the documentation of `org-diary'."
((eq arg :scheduled)
(setq rtn (org-agenda-get-scheduled deadline-results))
(setq results (append results rtn)))
+ ((eq arg :scheduled*)
+ (setq rtn (org-agenda-get-scheduled deadline-results t))
+ (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)))
+ ((eq arg :deadline*)
+ (setq rtn (org-agenda-get-deadlines t))
+ (setq deadline-results (copy-sequence rtn))
(setq results (append results rtn))))))))
results))))
+(defsubst org-em (x y list)
+ "Is X or Y a member of LIST?"
+ (or (memq x list) (memq y list)))
+
(defvar org-heading-keyword-regexp-format) ; defined in org.el
+(defvar org-agenda-sorting-strategy-selected nil)
+
(defun org-agenda-get-todos ()
"Return the TODO information for agenda display."
(let* ((props (list 'face nil
@@ -5073,8 +5361,8 @@ the documentation of `org-diary'."
"|")
"\\|") "\\)"))
(t org-not-done-regexp))))
- marker priority category category-pos tags todo-state
- ee txt beg end inherited-tags)
+ marker priority category category-pos level tags todo-state ts-date ts-date-type
+ ee txt beg end inherited-tags todo-state-end-pos)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -5082,6 +5370,10 @@ the documentation of `org-diary'."
(beginning-of-line)
(org-agenda-skip)
(setq beg (point) end (save-excursion (outline-next-heading) (point)))
+ (unless (and (setq todo-state (org-get-todo-state))
+ (setq todo-state-end-pos (match-end 2)))
+ (goto-char end)
+ (throw :skip nil))
(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))
@@ -5089,6 +5381,33 @@ the documentation of `org-diary'."
(goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category)
+ ts-date (let (ts)
+ (save-match-data
+ (cond ((org-em 'scheduled-up 'scheduled-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get (point) "SCHEDULED")
+ ts-date-type " scheduled"))
+ ((org-em 'deadline-up 'deadline-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get (point) "DEADLINE")
+ ts-date-type " deadline"))
+ ((org-em 'ts-up 'ts-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get (point) "TIMESTAMP")
+ ts-date-type " timestamp"))
+ ((org-em 'tsia-up 'tsia-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get (point) "TIMESTAMP_IA")
+ ts-date-type " timestamp_ia"))
+ ((org-em 'timestamp-up 'timestamp-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (or (org-entry-get (point) "SCHEDULED")
+ (org-entry-get (point) "DEADLINE")
+ (org-entry-get (point) "TIMESTAMP")
+ (org-entry-get (point) "TIMESTAMP_IA"))
+ ts-date-type ""))
+ (t (setq ts-date-type "")))
+ (when ts (ignore-errors (org-time-string-to-absolute ts)))))
category-pos (get-text-property (point) 'org-category-position)
txt (org-trim
(buffer-substring (match-beginning 2) (match-end 0)))
@@ -5100,17 +5419,19 @@ the documentation of `org-diary'."
(or (eq org-agenda-use-tag-inheritance t)
(memq 'todo org-agenda-use-tag-inheritance))))
tags (org-get-tags-at nil (not inherited-tags))
- txt (org-agenda-format-item "" txt category tags t)
- priority (1+ (org-get-priority txt))
- todo-state (org-get-todo-state))
+ level (make-string (org-reduced-level (org-outline-level)) ? )
+ txt (org-agenda-format-item "" txt level category tags t)
+ priority (1+ (org-get-priority txt)))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'priority priority 'org-category category
+ 'level level
+ 'ts-date ts-date
'org-category-position category-pos
- 'type "todo" 'todo-state todo-state)
+ 'type (concat "todo" ts-date-type) 'todo-state todo-state)
(push txt ee)
(if org-agenda-todo-list-sublevels
- (goto-char (match-end 2))
+ (goto-char todo-state-end-pos)
(org-end-of-subtree 'invisible))))
(nreverse ee)))
@@ -5119,7 +5440,8 @@ the documentation of `org-diary'."
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)))
+ (let ((days (org-time-stamp-to-now
+ time org-agenda-todo-ignore-time-comparison-use-seconds)))
(if (>= n 0)
(>= days n)
(<= days n))))
@@ -5139,9 +5461,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(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))
+ (> (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((eq org-agenda-todo-ignore-scheduled 'past)
- (<= (org-days-to-time (match-string 1)) 0))
+ (<= (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((numberp org-agenda-todo-ignore-scheduled)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-scheduled))
@@ -5153,9 +5477,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
((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))
+ (> (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((eq org-agenda-todo-ignore-deadlines 'past)
- (<= (org-days-to-time (match-string 1)) 0))
+ (<= (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((numberp org-agenda-todo-ignore-deadlines)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-deadlines))
@@ -5178,9 +5504,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(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))
+ (> (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((eq org-agenda-todo-ignore-timestamp 'past)
- (<= (org-days-to-time (match-string 1)) 0))
+ (<= (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((numberp org-agenda-todo-ignore-timestamp)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-timestamp))
@@ -5217,9 +5545,9 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
"\\|\\(<[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
+ donep tmp priority category category-pos level ee txt timestr tags
b0 b3 e3 head todo-state end-of-match show-all warntime habitp
- inherited-tags)
+ inherited-tags ts-date)
(goto-char (point-min))
(while (setq end-of-match (re-search-forward regexp nil t))
(setq b0 (match-beginning 0)
@@ -5278,18 +5606,21 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags)))
+ tags (org-get-tags-at nil (not inherited-tags))
+ level (make-string (org-reduced-level (org-outline-level)) ? ))
(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
+ head level category tags timestr
remove-re habitp)))
(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-add-props txt props 'priority priority
+ 'org-marker marker 'org-hd-marker hdmarker
'org-category category 'date date
+ 'level level
+ 'ts-date
+ (ignore-errors (org-time-string-to-absolute timestr))
'org-category-position category-pos
'todo-state todo-state
'warntime warntime
@@ -5309,7 +5640,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(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
+ marker category extra category-pos level ee txt tags entry
result beg b sexp sexp-entry todo-state warntime inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5326,6 +5657,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq result (org-diary-sexp-entry sexp sexp-entry date))
(when result
(setq marker (org-agenda-new-marker beg)
+ level (make-string (org-reduced-level (org-outline-level)) ? )
category (org-get-category beg)
category-pos (get-text-property beg 'org-category-position)
inherited-tags
@@ -5350,13 +5682,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(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
+ (setq txt (org-agenda-format-item extra txt level category tags 'time))
+ (org-add-props txt props 'org-marker marker
'org-category category 'date date 'todo-state todo-state
'org-category-position category-pos 'tags tags
+ 'level level
'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
@@ -5394,10 +5724,12 @@ 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."
+holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings,
+then those holidays will 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)))
+ (d (calendar-absolute-from-gregorian date))
+ (h (when skip-weeks (calendar-check-holidays date))))
(and
(<= date1 d)
(<= d date2)
@@ -5406,8 +5738,8 @@ holiday will also be skipped."
(progn
(require 'cal-iso)
(not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
- (not (and (memq 'holidays skip-weeks)
- (calendar-check-holidays date)))
+ (not (or (and h (memq 'holidays skip-weeks))
+ (delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
entry)))
(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
@@ -5465,7 +5797,7 @@ please use `org-class' instead."
(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
+ marker hdmarker priority category category-pos level tags closedp
statep clockp state ee txt extra timestr rest clocked inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5511,7 +5843,8 @@ please use `org-class' instead."
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags)))
+ tags (org-get-tags-at nil (not inherited-tags))
+ level (make-string (org-reduced-level (org-outline-level)) ? ))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
(setq txt (match-string 1))
(when extra
@@ -5524,12 +5857,13 @@ please use `org-class' instead."
(closedp "Closed: ")
(statep (concat "State: (" state ")"))
(t (concat "Clocked: (" clocked ")")))
- txt category tags timestr)))
+ txt level 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
+ 'level level
'type "closed" 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee))
@@ -5540,7 +5874,8 @@ please use `org-class' instead."
"Add overlays, showing issues with clocking.
See also the user option `org-agenda-clock-consistency-checks'."
(interactive)
- (let* ((pl org-agenda-clock-consistency-checks)
+ (let* ((org-time-clocksum-use-effort-durations nil)
+ (pl org-agenda-clock-consistency-checks)
(re (concat "^[ \t]*"
org-clock-string
"[ \t]+"
@@ -5589,13 +5924,13 @@ See also the user option `org-agenda-clock-consistency-checks'."
((> dt (* 60 maxtime))
;; a very long clocking chunk
(setq issue (format "Clocking interval is very long: %s"
- (org-minutes-to-hh:mm-string
+ (org-minutes-to-clocksum-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
+ (org-minutes-to-clocksum-string
(floor (/ (float dt) 60.))))
face (or (plist-get pl :short-face) face)))
((and (> tlend 0) (< ts tlend))
@@ -5655,8 +5990,10 @@ See also the user option `org-agenda-clock-consistency-checks'."
;; Nope, this gap is not OK
nil)))
-(defun org-agenda-get-deadlines ()
- "Return the deadline information for agenda display."
+(defun org-agenda-get-deadlines (&optional with-hour)
+ "Return the deadline information for agenda display.
+When WITH-HOUR is non-nil, only return deadlines with an hour
+specification like [h]h:mm."
(let* ((props (list 'mouse-face 'highlight
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
@@ -5664,26 +6001,21 @@ See also the user option `org-agenda-clock-consistency-checks'."
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
- (regexp org-deadline-time-regexp)
+ (regexp (if with-hour
+ org-deadline-time-hour-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
+ (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
+ (dl0 (car org-agenda-deadline-leaders))
+ (dl1 (nth 1 org-agenda-deadline-leaders))
+ (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1))
+ d2 diff dfrac wdays pos pos1 category category-pos level
tags suppress-prewarning ee txt head face s todo-state
- show-all upcomingp donep timestr warntime inherited-tags)
+ show-all upcomingp donep timestr warntime inherited-tags ts-date)
(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))
@@ -5692,10 +6024,32 @@ See also the user option `org-agenda-clock-consistency-checks'."
(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
+ s d1 'past show-all (current-buffer) pos)
+ diff (- d2 d1))
+ (setq suppress-prewarning
+ (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled
+ (let ((item (buffer-substring (point-at-bol)
+ (point-at-eol))))
+ (save-match-data
+ (and (string-match
+ org-scheduled-time-regexp item)
+ (match-string 1 item)))))))
+ (cond
+ ((not ds) nil)
+ ;; The current item has a scheduled date (in ds), so
+ ;; evaluate its prewarning lead time.
+ ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
+ ;; Use global prewarning-restart lead time.
+ org-agenda-skip-deadline-prewarning-if-scheduled)
+ ((eq org-agenda-skip-deadline-prewarning-if-scheduled
+ 'pre-scheduled)
+ ;; Set prewarning to no earlier than scheduled.
+ (min (- d2 (org-time-string-to-absolute
+ ds d1 'past show-all (current-buffer) pos))
+ org-deadline-warning-days))
+ ;; Set prewarning to deadline.
+ (t 0))))
+ (setq wdays (if suppress-prewarning
(let ((org-deadline-warning-days suppress-prewarning))
(org-get-wdays s))
(org-get-wdays s))
@@ -5721,6 +6075,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
(throw :skip nil)
(goto-char (match-end 0))
(setq pos1 (match-beginning 0))
+ (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
(setq inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -5738,22 +6093,25 @@ See also the user option `org-agenda-clock-consistency-checks'."
(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
+ (cond ((= diff 0) dl0)
+ ((> diff 0)
+ (if (functionp dl1)
+ (funcall dl1 diff date)
+ (format dl1 diff)))
+ (t
+ (if (functionp dl2)
+ (funcall dl2 diff date)
+ (format dl2 (if (string= dl2 dl1)
+ diff (abs diff))))))
+ head level 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
+ 'level level
+ 'ts-date d2
'org-hd-marker (org-agenda-new-marker pos1)
'priority (+ (- diff)
(org-get-priority txt))
@@ -5775,8 +6133,10 @@ FRACTION is what fraction of the head-warning time has passed."
(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."
+(defun org-agenda-get-scheduled (&optional deadline-results with-hour)
+ "Return the scheduled information for agenda display.
+When WITH-HOUR is non-nil, only return scheduled items with
+an hour specification like [h]h:mm."
(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
@@ -5785,7 +6145,9 @@ FRACTION is what fraction of the head-warning time has passed."
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
- (regexp org-scheduled-time-regexp)
+ (regexp (if with-hour
+ org-scheduled-time-hour-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
@@ -5794,9 +6156,10 @@ FRACTION is what fraction of the head-warning time has passed."
0 'org-hd-marker a))
(cons (marker-position mm) a)))
deadline-results))
- d2 diff pos pos1 category category-pos tags donep
+ d2 diff pos pos1 category category-pos level tags donep
ee txt head pastschedp todo-state face timestr s habitp show-all
- did-habit-check-p warntime inherited-tags)
+ did-habit-check-p warntime inherited-tags ts-date suppress-delay
+ ddays)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -5809,18 +6172,50 @@ FRACTION is what fraction of the head-warning time has passed."
(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)
+ s d1 'past show-all (current-buffer) pos)
diff (- d2 d1)
warntime (get-text-property (point) 'org-appt-warntime))
(setq pastschedp (and todayp (< diff 0)))
(setq did-habit-check-p nil)
+ (setq suppress-delay
+ (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline
+ (let ((item (buffer-substring (point-at-bol) (point-at-eol))))
+ (save-match-data
+ (and (string-match
+ org-deadline-time-regexp item)
+ (match-string 1 item)))))))
+ (cond
+ ((not ds) nil)
+ ;; The current item has a deadline date (in ds), so
+ ;; evaluate its delay time.
+ ((integerp org-agenda-skip-scheduled-delay-if-deadline)
+ ;; Use global delay time.
+ (- org-agenda-skip-scheduled-delay-if-deadline))
+ ((eq org-agenda-skip-scheduled-delay-if-deadline
+ 'post-deadline)
+ ;; Set delay to no later than deadline.
+ (min (- d2 (org-time-string-to-absolute
+ ds d1 'past show-all (current-buffer) pos))
+ org-scheduled-delay-days))
+ (t 0))))
+ (setq ddays (if suppress-delay
+ (let ((org-scheduled-delay-days suppress-delay))
+ (org-get-wdays s t t))
+ (org-get-wdays s t)))
+ ;; Use a delay of 0 when there is a repeater and the delay is
+ ;; of the form --3d
+ (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s))
+ (< (org-time-string-to-absolute s)
+ (org-time-string-to-absolute
+ s d2 'past nil (current-buffer) pos)))
+ (setq ddays 0))
;; When to show a scheduled item in the calendar:
;; If it is on or past the date.
- (when (or (and (< diff 0)
+ (when (or (and (> ddays 0) (= diff (- ddays)))
+ (and (zerop ddays) (= diff 0))
+ (and (< (+ diff ddays) 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
@@ -5842,6 +6237,10 @@ FRACTION is what fraction of the head-warning time has passed."
(org-is-habit-p))))
(setq category (org-get-category)
category-pos (get-text-property (point) 'org-category-position))
+ (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
+ 'repeated-after-deadline)
+ (<= 0 (- d2 (time-to-days (org-get-deadline-time (point))))))
+ (throw :skip nil))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(throw :skip nil)
(goto-char (match-end 0))
@@ -5854,7 +6253,7 @@ FRACTION is what fraction of the head-warning time has passed."
(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
+ (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today)
pastschedp))
(setq mm (assoc pos1 deadline-position-alist)))
(throw :skip nil)))
@@ -5865,7 +6264,9 @@ FRACTION is what fraction of the head-warning time has passed."
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda org-agenda-use-tag-inheritance))))
+
tags (org-get-tags-at nil (not inherited-tags)))
+ (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
(setq head (buffer-substring
(point)
(progn (skip-chars-forward "^\r\n") (point))))
@@ -5878,7 +6279,7 @@ FRACTION is what fraction of the head-warning time has passed."
(car org-agenda-scheduled-leaders)
(format (nth 1 org-agenda-scheduled-leaders)
(- 1 diff)))
- head category tags
+ head level category tags
(if (not (= diff 0)) nil timestr)
nil habitp))))
(when txt
@@ -5896,7 +6297,9 @@ FRACTION is what fraction of the head-warning time has passed."
'org-hd-marker (org-agenda-new-marker pos1)
'type (if pastschedp "past-scheduled" "scheduled")
'date (if pastschedp d2 date)
+ 'ts-date d2
'warntime warntime
+ 'level level
'priority (if habitp
(org-habit-get-priority habitp)
(+ 94 (- 5 diff) (org-get-priority txt)))
@@ -5920,7 +6323,7 @@ FRACTION is what fraction of the head-warning time has passed."
(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 inherited-tags)
+ level todo-state tags pos head donep inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -5954,7 +6357,9 @@ FRACTION is what fraction of the head-warning time has passed."
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda org-agenda-use-tag-inheritance))))
+
tags (org-get-tags-at nil (not inherited-tags)))
+ (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
(setq head (match-string 1))
(let ((remove-re
@@ -5969,7 +6374,7 @@ FRACTION is what fraction of the head-warning time has passed."
(nth (if (= d1 d2) 0 1)
org-agenda-timerange-leaders)
(1+ (- d0 d1)) (1+ (- d2 d1)))
- head category tags
+ head level category tags
(cond ((and (= d1 d0) (= d2 d0))
(concat "<" start-time ">--<" end-time ">"))
((= d1 d0)
@@ -5980,6 +6385,7 @@ FRACTION is what fraction of the head-warning time has passed."
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker
'type "block" 'date date
+ 'level level
'todo-state todo-state
'priority (org-get-priority txt) 'org-category category
'org-category-position category-pos)
@@ -5999,6 +6405,9 @@ 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-has-breadcrumbs nil
+ "A flag, set by `org-compile-prefix-format'.
+The flag is set if the currently compiled format contains a `%b'.")
(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
@@ -6012,20 +6421,23 @@ The flag is set if the currently compiled format contains a `%e'.")
(return (cadr entry))
(return (apply 'create-image (cdr entry)))))))
-(defun org-agenda-format-item (extra txt &optional category tags dotime
+(defun org-agenda-format-item (extra txt &optional level 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
+In particular, add the prefix and corresponding text properties.
+
+EXTRA must be a string to replace the `%s' specifier in the prefix format.
+LEVEL may be a string to replace the `%l' specifier.
+CATEGORY (a string, a 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.
+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
+ ;; 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
@@ -6038,13 +6450,14 @@ Any match of REMOVE-RE will be removed from TXT."
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)))
+ (setq txt (org-trim 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
@@ -6065,7 +6478,7 @@ Any match of REMOVE-RE will be removed from TXT."
(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)
+ duration thecategory breadcrumbs)
(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)
@@ -6093,10 +6506,12 @@ Any match of REMOVE-RE will be removed from TXT."
(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))))
+ (let (org-time-clocksum-use-effort-durations)
+ (when (and s1 (not s2) org-agenda-default-appointment-duration)
+ (setq s2
+ (org-minutes-to-clocksum-string
+ (+ (org-hh:mm-string-to-minutes s1)
+ org-agenda-default-appointment-duration)))))
;; Compute the duration
(when s2
@@ -6115,12 +6530,15 @@ Any match of REMOVE-RE will be removed from TXT."
(match-string 2 txt))
t t txt))))
(when (derived-mode-p 'org-mode)
- (setq effort (ignore-errors (get-text-property 0 'org-effort txt)))
- (when effort
+ (setq effort (ignore-errors (get-text-property 0 'org-effort txt))))
+
+ ;; org-agenda-add-time-grid-maybe calls us with *Agenda* as
+ ;; current buffer, so move this check outside of above
+ (if 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 ""))
+ effort (setq effort (concat "[" effort "]")))
+ ;; prevent erroring out with %e format when there is no effort
+ (setq effort ""))
(when remove-re
(while (string-match remove-re txt)
@@ -6131,6 +6549,10 @@ Any match of REMOVE-RE will be removed from TXT."
(add-text-properties 0 (length txt) '(org-heading t) txt)
;; Prepare the variables needed in the eval of the compiled format
+ (if org-prefix-has-breadcrumbs
+ (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker)
+ (let ((s (org-display-outline-path nil nil "->" t)))
+ (if (eq "" s) "" (concat s "->"))))))
(setq time (cond (s2 (concat
(org-agenda-time-of-day-to-ampm-maybe s1)
"-" (org-agenda-time-of-day-to-ampm-maybe s2)
@@ -6143,7 +6565,8 @@ Any match of REMOVE-RE will be removed from TXT."
(t ""))
extra (or (and (not habitp) extra) "")
category (if (symbolp category) (symbol-name category) category)
- thecategory (copy-sequence category))
+ thecategory (copy-sequence category)
+ level (or level ""))
(if (string-match org-bracket-link-regexp category)
(progn
(setq l (if (match-end 3)
@@ -6171,7 +6594,9 @@ Any match of REMOVE-RE will be removed from TXT."
'duration duration
'effort effort
'effort-minutes neffort
+ 'breadcrumbs breadcrumbs
'txt txt
+ 'level level
'time time
'extra extra
'format org-prefix-format-compiled
@@ -6216,9 +6641,13 @@ The modified list may contain inherited tags, and tags matched by
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)
+ "Add a time-grid for agenda items which need it.
+
+LIST is the list of agenda items formatted by `org-agenda-list'.
+NDAYS is the span of the current agenda view.
+TODAYP is `t' when the current agenda view is on today."
(catch 'exit
(cond ((not org-agenda-use-time-grid) (throw 'exit list))
((and todayp (member 'today (car org-agenda-time-grid))))
@@ -6240,16 +6669,14 @@ The modified list may contain inherited tags, and tags matched by
(unless (and remove (member time have))
(setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
(push (org-agenda-format-item
- nil string "" nil
+ nil string nil "" 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
+ nil org-agenda-current-time-string nil "" nil
(format-time-string "%H:%M "))
new)
(put-text-property
@@ -6263,9 +6690,11 @@ The modified list may contain inherited tags, and tags matched by
"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
+ (setq org-prefix-has-time nil
+ org-prefix-has-tag nil
org-prefix-category-length nil
- org-prefix-has-effort nil)
+ org-prefix-has-effort nil
+ org-prefix-has-breadcrumbs nil)
(let ((s (cond
((stringp org-agenda-prefix-format)
org-agenda-prefix-format)
@@ -6274,11 +6703,11 @@ and stored in the variable `org-prefix-format-compiled'."
(t " %-12:c%?-12t% s")))
(start 0)
varform vars var e c f opt)
- (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\|(.+)\\)"
+ (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)"
s start)
(setq var (or (cdr (assoc (match-string 4 s)
- '(("c" . category) ("t" . time) ("s" . extra)
- ("i" . category-icon) ("T" . tag) ("e" . effort))))
+ '(("c" . category) ("t" . time) ("l" . level) ("s" . extra)
+ ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs))))
'eval)
c (or (match-string 3 s) "")
opt (match-beginning 1)
@@ -6286,6 +6715,7 @@ and stored in the variable `org-prefix-format-compiled'."
(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))
+ (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t))
(setq f (concat "%" (match-string 2 s) "s"))
(when (equal var 'category)
(setq org-prefix-category-length
@@ -6312,7 +6742,8 @@ and stored in the variable `org-prefix-format-compiled'."
`((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))
+ (org-prefix-has-effort ,org-prefix-has-effort)
+ (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs))
`(format ,s ,@vars))))))
(defun org-set-sorting-strategy (key)
@@ -6372,14 +6803,69 @@ 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
+(defun org-agenda-finalize-entries (list &optional type)
+ "Sort, limit and concatenate the LIST of agenda items.
+The optional argument TYPE tells the agenda type."
+ (let ((max-effort (cond ((listp org-agenda-max-effort)
+ (cdr (assoc type org-agenda-max-effort)))
+ (t org-agenda-max-effort)))
+ (max-todo (cond ((listp org-agenda-max-todos)
+ (cdr (assoc type org-agenda-max-todos)))
+ (t org-agenda-max-todos)))
+ (max-tags (cond ((listp org-agenda-max-tags)
+ (cdr (assoc type org-agenda-max-tags)))
+ (t org-agenda-max-tags)))
+ (max-entries (cond ((listp org-agenda-max-entries)
+ (cdr (assoc type org-agenda-max-entries)))
+ (t org-agenda-max-entries))) l)
(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")))
+ (setq list
+ (delq nil
+ (mapcar
+ org-agenda-before-sorting-filter-function list))))
+ (setq list (mapcar 'org-agenda-highlight-todo list)
+ list (mapcar 'identity (sort list 'org-entries-lessp)))
+ (when max-effort
+ (setq list (org-agenda-limit-entries
+ list 'effort-minutes max-effort 'identity)))
+ (when max-todo
+ (setq list (org-agenda-limit-entries list 'todo-state max-todo)))
+ (when max-tags
+ (setq list (org-agenda-limit-entries list 'tags max-tags)))
+ (when max-entries
+ (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
+ (mapconcat 'identity list "\n")))
+
+(defun org-agenda-limit-entries (list prop limit &optional fn)
+ "Limit the number of agenda entries."
+ (let ((include (and limit (< limit 0))))
+ (if limit
+ (let ((fun (or fn (lambda (p) (if p 1))))
+ (lim 0))
+ (delq nil
+ (mapcar
+ (lambda (e)
+ (let ((pval (funcall fun (get-text-property 1 prop e))))
+ (if pval (setq lim (+ lim pval)))
+ (cond ((and pval (<= lim (abs limit))) e)
+ ((and include (not pval)) e))))
+ list)))
+ list)))
+
+(defun org-agenda-limit-interactively ()
+ "In agenda, interactively limit entries to various maximums."
+ (interactive)
+ (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
+ (num (string-to-number (read-from-minibuffer "How many? "))))
+ (cond ((equal max ?e)
+ (let ((org-agenda-max-entries num)) (org-agenda-redo)))
+ ((equal max ?t)
+ (let ((org-agenda-max-todos num)) (org-agenda-redo)))
+ ((equal max ?T)
+ (let ((org-agenda-max-tags num)) (org-agenda-redo)))
+ ((equal max ?E)
+ (let ((org-agenda-max-effort num)) (org-agenda-redo)))))
+ (org-agenda-fit-window-to-buffer))
(defun org-agenda-highlight-todo (x)
(let ((org-done-keywords org-done-keywords-for-agenda)
@@ -6506,6 +6992,20 @@ could bind the variable in the options section of a custom command.")
(cond ((< ta tb) -1)
((< tb ta) +1))))
+(defsubst org-cmp-ts (a b &optional type)
+ "Compare the timestamps values of entries A and B.
+When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
+\"timestamp_ia\", compare within each of these type. When TYPE
+is the empty string, compare all timestamps without respect of
+their type."
+ (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
+ (ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
+ (get-text-property 1 'ts-date a)) def))
+ (tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
+ (get-text-property 1 'ts-date 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))
@@ -6513,13 +7013,26 @@ could bind the variable in the options section of a custom command.")
(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)
+ (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss)
+ (org-cmp-ts a b "")))
+ (timestamp-down (if timestamp-up (- timestamp-up) nil))
+ (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss)
+ (org-cmp-ts a b "scheduled")))
+ (scheduled-down (if scheduled-up (- scheduled-up) nil))
+ (deadline-up (and (org-em 'deadline-up 'deadline-down ss)
+ (org-cmp-ts a b "deadline")))
+ (deadline-down (if deadline-up (- deadline-up) nil))
+ (tsia-up (and (org-em 'tsia-up 'tsia-down ss)
+ (org-cmp-ts a b "iatimestamp_ia")))
+ (tsia-down (if tsia-up (- tsia-up) nil))
+ (ts-up (and (org-em 'ts-up 'ts-down ss)
+ (org-cmp-ts a b "timestamp")))
+ (ts-down (if ts-up (- ts-up) nil))
(time-up (and (org-em 'time-up 'time-down ss)
(org-cmp-time a b)))
(time-down (if time-up (- time-up) nil))
@@ -6582,15 +7095,19 @@ in the file. Otherwise, restriction will be to the current subtree."
(t 'file)))
(if (eq type 'subtree)
(progn
- (setq org-agenda-restrict t)
+ (setq org-agenda-restrict (current-buffer))
(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-overlay org-agenda-restriction-lock-overlay
+ (point)
+ (if org-agenda-restriction-lock-highlight-subtree
+ (save-excursion (org-end-of-subtree t t) (point))
+ (point-at-eol)))
(move-marker org-agenda-restrict-begin (point))
(move-marker org-agenda-restrict-end
- (save-excursion (org-end-of-subtree t)))
+ (save-excursion (org-end-of-subtree t t)))
(message "Locking agenda restriction to subtree"))
(put 'org-agenda-files 'org-restrict
(list (buffer-file-name (buffer-base-buffer))))
@@ -6643,8 +7160,9 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search."
(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."
+(defun org-agenda-Quit ()
+ "Exit the agenda and kill buffers loaded by `org-agenda'.
+Also restore the window configuration."
(interactive)
(if org-agenda-columns-active
(org-columns-quit)
@@ -6663,6 +7181,7 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search."
(kill-buffer buf)
(org-columns-remove-overlays)
(setq org-agenda-archives-mode nil)))
+ (setq org-agenda-buffer nil)
;; Maybe restore the pre-agenda window configuration.
(and org-agenda-restore-windows-after-quit
(not (eq org-agenda-window-setup 'other-frame))
@@ -6671,8 +7190,8 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search."
(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"
+ "Exit the agenda and restore the window configuration.
+When `org-agenda-sticky' is non-nil, only bury the agenda."
(interactive)
(if (and (eq org-indirect-buffer-display 'other-window)
org-last-indirect-buffer)
@@ -6701,9 +7220,9 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search."
(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."
+ "Exit the agenda and restore the window configuration.
+Also kill Org-mode buffers 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)
@@ -6711,8 +7230,8 @@ Org-mode buffers visited directly by the user will not be touched."
(defun org-agenda-kill-all-agenda-buffers ()
"Kill all buffers in `org-agenda-mode'.
-This is used when toggling sticky agendas. You can also explicitly invoke it
-with `C-c a C-k'."
+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))
@@ -6740,9 +7259,11 @@ in the agenda."
(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)
+ (top-hl-filter org-agenda-top-headline-filter)
(cat-filter org-agenda-category-filter)
(cat-preset (get 'org-agenda-category-filter :preset-filter))
+ (re-filter org-agenda-regexp-filter)
+ (re-preset (get 'org-agenda-regexp-filter :preset-filter))
(org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
@@ -6760,19 +7281,26 @@ in the agenda."
(series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
(put 'org-agenda-tag-filter :preset-filter nil)
(put 'org-agenda-category-filter :preset-filter nil)
+ (put 'org-agenda-regexp-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(if series-redo-cmd
(eval series-redo-cmd)
- (org-let lprops '(eval redo-cmd)))
+ (org-let lprops redo-cmd))
(setq org-agenda-undo-list nil
- org-agenda-pending-undo-list nil)
+ org-agenda-pending-undo-list nil
+ org-agenda-tag-filter tag-filter
+ org-agenda-category-filter cat-filter
+ org-agenda-regexp-filter re-filter
+ org-agenda-top-headline-filter top-hl-filter)
(message "Rebuilding agenda buffer...done")
(put 'org-agenda-tag-filter :preset-filter tag-preset)
(put 'org-agenda-category-filter :preset-filter cat-preset)
+ (put 'org-agenda-regexp-filter :preset-filter re-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 (or re-filter re-preset) (org-agenda-filter-apply re-filter 'regexp))
+ (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
(and cols (org-called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(recenter window-line)))
@@ -6789,11 +7317,18 @@ The category is that of the current line."
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)
+ (cond
+ ((and cat strip)
+ (org-agenda-filter-apply
+ (push (concat "-" cat) org-agenda-category-filter) 'category))
+ ((and cat)
+ (org-agenda-filter-apply
+ (setq org-agenda-category-filter
+ (list (concat "+" cat))) 'category))
+ ((error "No category at point"))))))
+
+(defun org-find-top-headline (&optional pos)
+ "Find the topmost parent headline and return it."
(save-excursion
(with-current-buffer (if pos (marker-buffer pos) (current-buffer))
(if pos (goto-char pos))
@@ -6802,21 +7337,49 @@ The category is that of the current line."
(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."
+(defvar org-agenda-filtered-by-top-headline nil)
+(defun org-agenda-filter-by-top-headline (strip)
+ "Keep only those lines that are descendants from the same top headline.
+The top headline is that of the current line."
(interactive "P")
- (if org-agenda-filtered-by-top-category
+ (if org-agenda-filtered-by-top-headline
(progn
- (setq org-agenda-filtered-by-top-category nil
- org-agenda-top-category-filter nil)
+ (setq org-agenda-filtered-by-top-headline nil
+ org-agenda-top-headline-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)
+ (let ((cat (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
+ (if cat (org-agenda-filter-top-headline-apply cat strip)
(error "No top-level category at point")))))
+(defvar org-agenda-regexp-filter nil)
+(defun org-agenda-filter-by-regexp (strip)
+ "Filter agenda entries by a regular expression.
+Regexp filters are cumulative.
+With no prefix argument, keep entries matching the regexp.
+With one prefix argument, filter out entries matching the regexp.
+With two prefix arguments, remove the regexp filters."
+ (interactive "P")
+ (if (not (equal strip '(16)))
+ (let ((flt (concat (if (equal strip '(4)) "-" "+")
+ (read-from-minibuffer
+ (if (equal strip '(4))
+ "Filter out entries matching regexp: "
+ "Narrow to entries matching regexp: ")))))
+ (push flt org-agenda-regexp-filter)
+ (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
+ (org-agenda-filter-show-all-re)
+ (message "Regexp filter removed")))
+
+(defun org-agenda-filter-remove-all ()
+ "Remove all filters from the current agenda buffer."
+ (interactive)
+ (when org-agenda-tag-filter
+ (org-agenda-filter-show-all-tag))
+ (when org-agenda-category-filter
+ (org-agenda-filter-show-all-cat))
+ (when org-agenda-regexp-filter
+ (org-agenda-filter-show-all-re)))
+
(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.
@@ -6881,7 +7444,7 @@ to switch to narrowing."
((equal char ?\r)
(org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
- (setq org-agenda-tag-filter '())
+ (setq org-agenda-tag-filter nil)
(dolist (tag (org-agenda-get-represented-tags))
(let ((modifier (funcall org-agenda-auto-exclude-function tag)))
(if modifier
@@ -6938,29 +7501,61 @@ to switch to narrowing."
(interactive "P")
(org-agenda-filter-by-tag strip char 'refine))
-(defun org-agenda-filter-make-matcher ()
+(defun org-agenda-filter-make-matcher (filter type)
"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))
+ (cond
+ ;; Tag filter
+ ((eq type 'tag)
+ (setq filter
+ (delete-dups
+ (append (get 'org-agenda-tag-filter :preset-filter)
+ filter)))
+ (dolist (x filter)
+ (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
+ (ffunc
+ (lambda (nf0 nf01 fltr notgroup op)
+ (dolist (x fltr)
+ (if (member x '("-" "+"))
+ (setq nf01 (if (equal x "-") 'tags '(not tags)))
+ (if (string-match "[<=>?]" x)
+ (setq nf01 (org-agenda-filter-effort-form x))
+ (setq nf01 (list 'member (downcase (substring x 1))
+ 'tags)))
+ (when (equal (string-to-char x) ?-)
+ (setq nf01 (list 'not nf01))
+ (when (not notgroup) (setq op 'and))))
+ (push nf01 nf0))
+ (if notgroup
+ (push (cons 'and nf0) f)
+ (push (cons (or op 'or) nf0) f)))))
+ (cond ((equal filter '("+"))
+ (setq f (list (list 'not 'tags))))
+ ((equal nfilter filter)
+ (funcall ffunc f1 f filter t nil))
+ (t (funcall ffunc nf1 nf nfilter nil nil))))))
+ ;; Category filter
+ ((eq type 'category)
+ (setq filter
+ (delete-dups
+ (append (get 'org-agenda-category-filter :preset-filter)
+ filter)))
+ (dolist (x 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)))
+ ;; Regexp filter
+ ((eq type 'regexp)
+ (setq filter
+ (delete-dups
+ (append (get 'org-agenda-regexp-filter :preset-filter)
+ filter)))
+ (dolist (x filter)
+ (if (equal "-" (substring x 0 1))
+ (setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
+ (setq f1 (list 'string-match (substring x 1) 'txt)))
+ (push f1 f))))
(cons 'and (nreverse f))))
(defun org-agenda-filter-effort-form (e)
@@ -6985,13 +7580,31 @@ If the line does not have an effort defined, return nil."
(funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
value))))
+(defun org-agenda-filter-expand-tags (filter &optional no-operator)
+ "Expand group tags in FILTER for the agenda.
+When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
+ (if org-group-tags
+ (let ((case-fold-search t) rtn)
+ (mapc
+ (lambda (f)
+ (let (f0 dir)
+ (if (string-match "^\\([+-]\\)\\(.+\\)" f)
+ (setq dir (match-string 1 f) f0 (match-string 2 f))
+ (setq dir (if no-operator "" "+") f0 f))
+ (setq rtn (append (mapcar (lambda(f1) (concat dir f1))
+ (org-tags-expand f0 t t))
+ rtn))))
+ filter)
+ (reverse rtn))
+ filter))
+
(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))
+ ;; Deactivate `org-agenda-entry-text-mode' when filtering
+ (if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
+ (let (tags cat txt)
+ (setq org-agenda-filter-form
+ (org-agenda-filter-make-matcher filter type))
(if (and (eq type 'category)
(not (equal (substring (car filter) 0 1) "-")))
;; Only set `org-agenda-filtered-by-category' to t
@@ -7003,8 +7616,13 @@ If the line does not have an effort defined, return nil."
(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))
+ (setq tags ; used in eval
+ (apply 'append
+ (mapcar (lambda (f)
+ (org-agenda-filter-expand-tags (list f) t))
+ (org-get-at-bol 'tags)))
+ cat (get-text-property (point) 'org-category)
+ txt (get-text-property (point) 'txt))
(if (not (eval org-agenda-filter-form))
(org-agenda-filter-hide-line type))
(beginning-of-line 2))
@@ -7012,32 +7630,33 @@ If the line does not have an effort defined, return nil."
(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."
+(defun org-agenda-filter-top-headline-apply (hl &optional negative)
+ "Filter by top headline HL."
(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)))
+ (tophl (and pos (org-find-top-headline pos))))
+ (if (and tophl (funcall (if negative 'identity 'not)
+ (string= hl tophl)))
(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))
+ (setq org-agenda-top-headline-filter hl
+ org-agenda-filtered-by-top-headline t))
(defun org-agenda-filter-hide-line (type)
+ "Hide lines with TYPE in the agenda buffer."
(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))))
+ (cond ((eq type 'tag) (push ov org-agenda-tag-filter-overlays))
+ ((eq type 'category) (push ov org-agenda-cat-filter-overlays))
+ ((eq type 'regexp) (push ov org-agenda-re-filter-overlays)))))
(defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
(setq pos (or pos (point)))
@@ -7051,13 +7670,23 @@ If the line does not have an effort defined, return nil."
(overlay-end ov)))))))
(defun org-agenda-filter-show-all-tag nil
+ "Remove tag filter overlays from the agenda buffer."
(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-re nil
+ "Remove regexp filter overlays from the agenda buffer."
+ (mapc 'delete-overlay org-agenda-re-filter-overlays)
+ (setq org-agenda-re-filter-overlays nil
+ org-agenda-regexp-filter nil
+ org-agenda-filter-form nil)
+ (org-agenda-set-mode-name))
+
(defun org-agenda-filter-show-all-cat nil
+ "Remove category filter overlays from the agenda buffer."
(mapc 'delete-overlay org-agenda-cat-filter-overlays)
(setq org-agenda-cat-filter-overlays nil
org-agenda-filtered-by-category nil
@@ -7121,23 +7750,31 @@ Negative selection means regexp must not match for selection of an entry."
(let* ((org-read-date-prefer-future
(eval org-agenda-jump-prefer-future))
(date (org-read-date))
+ (day (time-to-days (org-time-string-to-time 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))
+ (with-hour-p (nth 4 org-agenda-redo-command))
(newcmd (list 'org-agenda-list 0-arg date
- (org-agenda-span-to-ndays 2-arg)))
+ (org-agenda-span-to-ndays
+ 2-arg (org-time-string-to-absolute date))
+ with-hour-p))
(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")
+ (error "Not available in non-agenda views")
(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))))
+ (goto-char (point-min))
+ (while (not (or (= (or (get-text-property (point) 'day) 0) day)
+ (save-excursion (move-beginning-of-line 2) (eobp))))
+ (move-beginning-of-line 2))
+ (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."
@@ -7203,6 +7840,8 @@ With prefix ARG, go forward that many times the current span."
(setq sd (+ arg sd)))
((eq span 'week)
(setq sd (+ (* 7 arg) sd)))
+ ((eq span 'fortnight)
+ (setq sd (+ (* 14 arg) sd)))
((eq span 'month)
(setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
sd (calendar-absolute-from-gregorian greg2))
@@ -7232,7 +7871,7 @@ With prefix ARG, go backward that many times the current span."
(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
+ (message "View: [d]ay [w]eek for[t]night [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)))
@@ -7240,6 +7879,7 @@ With prefix ARG, go backward that many times the current span."
(?\ (call-interactively 'org-agenda-reset-view))
(?d (call-interactively 'org-agenda-day-view))
(?w (call-interactively 'org-agenda-week-view))
+ (?t (call-interactively 'org-agenda-fortnight-view))
(?m (call-interactively 'org-agenda-month-view))
(?y (call-interactively 'org-agenda-year-view))
(?l (call-interactively 'org-agenda-log-mode))
@@ -7264,11 +7904,11 @@ With prefix ARG, go backward that many times the current span."
"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)
+(defun org-agenda-day-view (&optional day-of-month)
"Switch to daily view for agenda.
-With argument DAY-OF-YEAR, switch to that day of the year."
+With argument DAY-OF-MONTH, switch to that day of the month."
(interactive "P")
- (org-agenda-change-time-span 'day day-of-year))
+ (org-agenda-change-time-span 'day day-of-month))
(defun org-agenda-week-view (&optional iso-week)
"Switch to daily view for agenda.
With argument ISO-WEEK, switch to the corresponding ISO week.
@@ -7278,6 +7918,15 @@ 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-fortnight-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 'fortnight iso-week))
(defun org-agenda-month-view (&optional month)
"Switch to monthly view for agenda.
With argument MONTH, switch to that month."
@@ -7299,7 +7948,7 @@ written as 2-digit years."
(defun org-agenda-change-time-span (span &optional n)
"Change the agenda view to SPAN.
-SPAN may be `day', `week', `month', `year'."
+SPAN may be `day', `week', `fortnight', `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)))
@@ -7320,7 +7969,7 @@ SPAN may be `day', `week', `month', `year'."
(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
+SPAN may be `day', `week', `fortnight', `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))
@@ -7333,7 +7982,7 @@ so that the date SD will be in that range."
(setq sd (+ (calendar-absolute-from-gregorian
(list mg 1 yg))
n -1))))
- ((eq span 'week)
+ ((or (eq span 'week) (eq span 'fortnight))
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(d (if org-agenda-start-on-weekday
@@ -7418,17 +8067,24 @@ so that the date SD will be in that range."
(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)))
+ (if (or org-agenda-tag-filter
+ org-agenda-category-filter
+ org-agenda-regexp-filter
+ org-agenda-top-headline-filter)
+ (user-error "Can't show entry text in filtered views")
+ (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%s"
+ (if org-agenda-entry-text-mode "on" "off")
+ (if (not org-agenda-entry-text-mode) ""
+ (format " (maximum number of lines is %d)"
+ (if (integerp arg) arg org-agenda-entry-text-maxlines))))))
(defun org-agenda-clockreport-mode (&optional with-filter)
"Toggle clocktable mode in an agenda buffer.
@@ -7532,8 +8188,8 @@ When called with a prefix argument, include all archive files as well."
((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))
+ (if (or org-agenda-category-filter
+ (get 'org-agenda-category-filter :preset-filter))
'(:eval (org-propertize
(concat " <"
(mapconcat
@@ -7544,10 +8200,9 @@ When called with a prefix argument, include all archive files as well."
"")
">")
'face 'org-agenda-filter-category
- 'help-echo "Category used in filtering"))
- "")
- (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter
- :preset-filter))
+ 'help-echo "Category used in filtering")) "")
+ (if (or org-agenda-tag-filter
+ (get 'org-agenda-tag-filter :preset-filter))
'(:eval (org-propertize
(concat " {"
(mapconcat
@@ -7558,8 +8213,20 @@ When called with a prefix argument, include all archive files as well."
"")
"}")
'face 'org-agenda-filter-tags
- 'help-echo "Tags used in filtering"))
- "")
+ 'help-echo "Tags used in filtering")) "")
+ (if (or org-agenda-regexp-filter
+ (get 'org-agenda-regexp-filter :preset-filter))
+ '(:eval (org-propertize
+ (concat " ["
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-regexp-filter :preset-filter)
+ org-agenda-regexp-filter)
+ "")
+ "]")
+ 'face 'org-agenda-filter-regexp
+ 'help-echo "Regexp used in filtering")) "")
(if org-agenda-archives-mode
(if (eq org-agenda-archives-mode t)
" Archives"
@@ -7734,7 +8401,7 @@ Point is in the buffer where the item originated.")
(if (and confirm
(not (y-or-n-p "Archive this subtree or entry? ")))
(error "Abort")
- (save-excursion
+ (save-window-excursion
(goto-char pos)
(let ((org-agenda-buffer-name bufname-orig))
(org-remove-subtree-entries-from-agenda))
@@ -7768,10 +8435,19 @@ If this information is not given, the function uses the tree at point."
(beginning-of-line 0))))))
(defun org-agenda-refile (&optional goto rfloc no-update)
- "Refile the item at point."
+ "Refile the item at point.
+
+When GOTO is 0 or '(64), clear the refile cache.
+When GOTO is '(16), go to the location of the last refiled item.
+RFLOC can be a refile location obtained in a different way.
+When NO-UPDATE is non-nil, don't redo the agenda buffer."
(interactive "P")
- (if (equal goto '(16))
- (org-refile-goto-last-stored)
+ (cond
+ ((member goto '(0 (64)))
+ (org-refile-cache-clear))
+ ((equal goto '(16))
+ (org-refile-goto-last-stored))
+ (t
(let* ((buffer-orig (buffer-name))
(marker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
@@ -7789,7 +8465,7 @@ If this information is not given, the function uses the tree at point."
(let ((org-agenda-buffer-name buffer-orig))
(org-remove-subtree-entries-from-agenda))
(org-refile goto buffer rfloc)))))
- (unless no-update (org-agenda-redo))))
+ (unless no-update (org-agenda-redo)))))
(defun org-agenda-open-link (&optional arg)
"Open the link(s) in the current entry, if any.
@@ -8147,7 +8823,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(save-excursion (save-restriction (widen)
(goto-char hdmarker)
(org-get-tags-at)))))
- props m pl undone-face done-face finish new dotime cat tags)
+ props m pl undone-face done-face finish new dotime level cat tags)
(save-excursion
(goto-char (point-max))
(beginning-of-line 1)
@@ -8159,6 +8835,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(setq props (text-properties-at (point))
dotime (org-get-at-bol 'dotime)
cat (org-get-at-bol 'org-category)
+ level (org-get-at-bol 'level)
tags thetags
new
(let ((org-prefix-format-compiled
@@ -8169,7 +8846,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(save-excursion
(save-restriction
(widen)
- (org-agenda-format-item extra newhead cat tags dotime)))))
+ (org-agenda-format-item extra newhead level 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))
@@ -8472,7 +9149,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(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-move-to-column (- (window-width) (length stamp)) t nil t)
(org-agenda-fix-tags-filter-overlays-at (point))
(if (featurep 'xemacs)
;; Use `duplicable' property to trigger undo recording
@@ -8560,9 +9237,9 @@ ARG is passed through to `org-deadline'."
(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))
+ (hdmarker (or (org-get-at-bol 'org-hd-marker) marker))
(pos (marker-position marker))
+ (col (current-column))
newhead)
(org-with-remote-undo (marker-buffer marker)
(with-current-buffer (marker-buffer marker)
@@ -8573,14 +9250,15 @@ ARG is passed through to `org-deadline'."
(org-cycle-hide-drawers 'children)
(org-clock-in arg)
(setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker)))))
+ (org-agenda-change-all-lines newhead hdmarker))
+ (org-move-to-column col))))
(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)
+ (let ((marker (make-marker)) (col (current-column)) newhead)
(org-with-remote-undo (marker-buffer org-clock-marker)
(with-current-buffer (marker-buffer org-clock-marker)
(save-excursion
@@ -8592,13 +9270,15 @@ ARG is passed through to `org-deadline'."
(org-clock-out)
(setq newhead (org-get-heading))))))
(org-agenda-change-all-lines newhead marker)
- (move-marker marker nil)))
+ (move-marker marker nil)
+ (org-move-to-column col)
+ (org-agenda-unmark-clocking-task)))
(defun org-agenda-clock-cancel (&optional arg)
"Cancel the currently running clock."
(interactive "P")
(unless (marker-buffer org-clock-marker)
- (error "No running clock"))
+ (user-error "No running clock"))
(org-with-remote-undo (marker-buffer org-clock-marker)
(org-clock-cancel)))
@@ -8626,7 +9306,7 @@ buffer, display it in another window."
(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"))
+ (unless dp1 (user-error "No date defined in current line"))
(setq d1 (calendar-gregorian-from-absolute dp1)
d2 (and (ignore-errors (mark))
(save-excursion
@@ -8650,7 +9330,7 @@ buffer, display it in another window."
((equal char ?b)
(setq text (read-string "Block entry: "))
(unless (and d1 d2 (not (equal d1 d2)))
- (error "No block of days selected"))
+ (user-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)
@@ -8659,7 +9339,7 @@ buffer, display it in another window."
(require 'org-datetree)
(org-datetree-find-date-create d1)
(org-reveal t))
- (t (error "Invalid selection character `%c'" char)))))
+ (t (user-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?
@@ -8717,7 +9397,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to
;; 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)
+ (setq fmt (org-agenda-format-item nil text nil nil nil t)
time (get-text-property 0 'time fmt)
time2 (if (> (length time) 0)
;; split-string removes trailing ...... if
@@ -8819,11 +9499,11 @@ entries in that Org-mode file."
(point (point))
(mark (or (mark t) (point))))
(unless cmd
- (error "No command associated with <%c>" char))
+ (user-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"))
+ (user-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
@@ -8844,7 +9524,7 @@ entries in that Org-mode file."
(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"))
+ (user-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
@@ -8893,7 +9573,7 @@ argument, latitude and longitude will be prompted for."
(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")))
+ (user-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)
@@ -8916,7 +9596,7 @@ This is a command that has to be installed in `calendar-mode-map'."
(let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
date s)
(unless day
- (error "Don't know which date to convert"))
+ (user-error "Don't know which date to convert"))
(setq date (calendar-gregorian-from-absolute day))
(setq s (concat
"Gregorian: " (calendar-date-string date) "\n"
@@ -8952,14 +9632,17 @@ This is a command that has to be installed in `calendar-mode-map'."
(let* ((m (org-get-at-bol 'org-hd-marker))
ov)
(unless (org-agenda-bulk-marked-p)
- (unless m (error "Nothing to mark at point"))
+ (unless m (user-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)
+ (end-of-line 1)
+ (or (ignore-errors
+ (goto-char (next-single-property-change (point) 'txt)))
+ (beginning-of-line 2))
(while (and (get-char-property (point) 'invisible) (not (eobp)))
(beginning-of-line 2))
(message "%d entries marked for bulk action"
@@ -8973,12 +9656,13 @@ This is a command that has to be installed in `calendar-mode-map'."
(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))
+ (let ((entries-marked 0) txt-at-point)
(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))
+ (while (and (re-search-forward regexp nil t)
+ (setq txt-at-point (get-text-property (point) 'txt)))
+ (when (string-match regexp txt-at-point)
(setq entries-marked (1+ entries-marked))
(call-interactively 'org-agenda-bulk-mark))))
(if (not entries-marked)
@@ -8995,15 +9679,27 @@ This is a command that has to be installed in `calendar-mode-map'."
(setq org-agenda-bulk-marked-entries
(delete (org-get-at-bol 'org-hd-marker)
org-agenda-bulk-marked-entries))
- (beginning-of-line 2)
+ (end-of-line 1)
+ (or (ignore-errors
+ (goto-char (next-single-property-change (point) 'txt)))
+ (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-all ()
+ "Toggle all marks for bulk action."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (while (ignore-errors
+ (goto-char (next-single-property-change (point) 'txt)))
+ (org-agenda-bulk-toggle))))
+
(defun org-agenda-bulk-toggle ()
- "Toggle marking the entry at point for bulk action."
+ "Toggle the mark at point for bulk action."
(interactive)
(if (org-agenda-bulk-marked-p)
(org-agenda-bulk-unmark)
@@ -9044,14 +9740,14 @@ bulk action."
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"))
+ (unless org-agenda-bulk-marked-entries (user-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)))
+ (user-error "Marker %s for bulk command is invalid" m)))
org-agenda-bulk-marked-entries)
;; Prompt for the bulk command
@@ -9130,7 +9826,7 @@ The prefix arg is passed through to the command if possible."
((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)
+ (user-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)))
@@ -9168,7 +9864,7 @@ The prefix arg is passed through to the command if possible."
(org-icompleting-read "Function: "
obarray 'fboundp t nil nil)))))
- (t (error "Invalid bulk action")))
+ (t (user-error "Invalid bulk action")))
;; Sort the markers, to make sure that parents are handled before children
(setq entries (sort entries
@@ -9202,15 +9898,45 @@ The prefix arg is passed through to the command if possible."
(if (not org-agenda-persistent-marks)
"" " (kept marked)"))))))
-(defun org-agenda-capture ()
- "Call `org-capture' with the date at point."
- (interactive)
+(defun org-agenda-capture (&optional with-time)
+ "Call `org-capture' with the date at point.
+With a `C-1' prefix, use the HH:MM value at point (if any) or the
+current HH:MM time."
+ (interactive "P")
(if (not (eq major-mode 'org-agenda-mode))
- (error "You cannot do this outside of agenda buffers")
+ (user-error "You cannot do this outside of agenda buffers")
(let ((org-overriding-default-time
- (org-get-cursor-date)))
+ (org-get-cursor-date (equal with-time 1))))
(call-interactively 'org-capture))))
+;;; Dragging agenda lines forward/backward
+
+(defun org-agenda-drag-line-forward (arg)
+ "Drag an agenda line forward by ARG lines."
+ (interactive "p")
+ (let ((inhibit-read-only t) lst)
+ (if (or (not (get-text-property (point) 'txt))
+ (save-excursion
+ (dotimes (n arg)
+ (move-beginning-of-line 2)
+ (push (not (get-text-property (point) 'txt)) lst))
+ (delq nil lst)))
+ (message "Cannot move line forward")
+ (org-drag-line-forward arg))))
+
+(defun org-agenda-drag-line-backward (arg)
+ "Drag an agenda line backward by ARG lines."
+ (interactive "p")
+ (let ((inhibit-read-only t) lst)
+ (if (or (not (get-text-property (point) 'txt))
+ (save-excursion
+ (dotimes (n arg)
+ (move-beginning-of-line 0)
+ (push (not (get-text-property (point) 'txt)) lst))
+ (delq nil lst)))
+ (message "Cannot move line backward")
+ (org-drag-line-backward arg))))
+
;;; Flagging notes
(defun org-agenda-show-the-flagging-note ()
@@ -9222,7 +9948,7 @@ tag and (if present) the flagging note."
(win (selected-window))
note heading newhead)
(unless hdmarker
- (error "No linked entry at point"))
+ (user-error "No linked entry at point"))
(if (and (eq this-command last-command)
(y-or-n-p "Unflag and remove any flagging note? "))
(progn
@@ -9232,7 +9958,7 @@ tag and (if present) the flagging note."
(message "Entry unflagged"))
(setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
(unless note
- (error "No flagging note"))
+ (user-error "No flagging note"))
(org-kill-new note)
(org-switch-to-buffer-other-window "*Flagging Note*")
(erase-buffer)
@@ -9288,7 +10014,8 @@ 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
+By default `org-agenda-to-appt' will use :deadline*, :scheduled*
+\(i.e., deadlines and scheduled items with a hh:mm specification)
and :timestamp entries. See the docstring of `org-diary' for
details and examples.
@@ -9299,7 +10026,7 @@ to override `appt-message-warning-time'."
(if (eq filter t)
(setq filter (read-from-minibuffer "Regexp filter: ")))
(let* ((cnt 0) ; count added events
- (scope (or args '(:deadline :scheduled :timestamp)))
+ (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
@@ -9321,7 +10048,10 @@ to override `appt-message-warning-time'."
;; 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) "")))
+ (let* ((evt (org-trim
+ (replace-regexp-in-string
+ org-bracket-link-regexp "\\3"
+ (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)
diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el
index 2fcfc8634f..d5bdff16f9 100644
--- a/lisp/org/org-archive.el
+++ b/lisp/org/org-archive.el
@@ -71,6 +71,15 @@ This variable is obsolete and has no effect anymore, instead add or remove
:group 'org-archive
:type 'boolean)
+(defcustom org-archive-file-header-format "\nArchived entries from file %s\n\n"
+ "The header format string for newly created archive files.
+When nil, no header will be inserted.
+When a string, a %s formatter will be replaced by the file name."
+ :group 'org-archive
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
(defcustom org-archive-subtree-add-inherited-tags 'infile
"Non-nil means append inherited tags when archiving a subtree."
:group 'org-archive
@@ -278,9 +287,9 @@ this heading."
(let ((org-insert-mode-line-in-empty-file t)
(org-inhibit-startup t))
(call-interactively 'org-mode)))
- (when newfile-p
+ (when (and newfile-p org-archive-file-header-format)
(goto-char (point-max))
- (insert (format "\nArchived entries from file %s\n\n"
+ (insert (format org-archive-file-header-format
(buffer-file-name this-buffer))))
(when datetree-date
(require 'org-datetree)
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index 3e665b79da..898d9116e7 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -42,6 +42,8 @@
(require 'org-id)
(require 'org)
+(declare-function vc-git-root "vc-git" (file))
+
(defgroup org-attach nil
"Options concerning entry attachments in Org-mode."
:tag "Org Attach"
@@ -54,6 +56,15 @@ where the Org file lives."
:group 'org-attach
:type 'directory)
+(defcustom org-attach-git-annex-cutoff (* 32 1024)
+ "If non-nil, files larger than this will be annexed instead of stored."
+ :group 'org-attach
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "None" nil)
+ (integer :tag "Bytes")))
+
(defcustom org-attach-auto-tag "ATTACH"
"Tag that will be triggered automatically when an entry has an attachment."
:group 'org-attach
@@ -252,18 +263,32 @@ the ATTACH_DIR property) their own 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))
+ (let* ((dir (expand-file-name org-attach-directory))
+ (git-dir (vc-git-root dir))
+ (changes 0))
+ (when 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'")))))
+ (let ((have-annex
+ (and org-attach-git-annex-cutoff
+ (file-exists-p (expand-file-name "annex" git-dir)))))
+ (dolist (new-or-modified
+ (split-string
+ (shell-command-to-string
+ "git ls-files -zmo --exclude-standard") "\0" t))
+ (if (and have-annex
+ (>= (nth 7 (file-attributes new-or-modified))
+ org-attach-git-annex-cutoff))
+ (call-process "git" nil nil nil "annex" "add" new-or-modified)
+ (call-process "git" nil nil nil "add" new-or-modified))
+ (incf changes)))
+ (dolist (deleted
+ (split-string
+ (shell-command-to-string "git ls-files -z --deleted") "\0" t))
+ (call-process "git" nil nil nil "rm" deleted)
+ (incf changes))
+ (when (> changes 0)
+ (shell-command "git commit -m 'Synchronized attachments'"))))))
(defun org-attach-tag (&optional off)
"Turn the autotag on or (if OFF is set) off."
@@ -405,14 +430,14 @@ This ignores files starting with a \".\", and files ending in \"~\"."
(directory-files dir nil "[^~]\\'"))))
(defun org-attach-reveal (&optional if-exists)
- "Show the attachment directory of the current task in dired."
+ "Show the attachment directory of the current task.
+This will attempt to use an external program to show the directory."
(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."
+ "Show the attachment directory of the current task in dired."
(interactive)
(let ((attach-dir (org-attach-dir t)))
(dired attach-dir)))
diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el
index a45a26f0fe..f122b67ea1 100644
--- a/lisp/org/org-bbdb.el
+++ b/lisp/org/org-bbdb.el
@@ -116,8 +116,10 @@
(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
+;; `bbdb-record-note' was part of BBDB v3.x
(declare-function bbdb-record-note "ext:bbdb" (record label))
+;; `bbdb-record-xfield' replaces it in recent BBDB v3.x+
+(declare-function bbdb-record-xfield "ext:bbdb" (record label))
(declare-function calendar-leap-year-p "calendar" (year))
(declare-function diary-ordinal-suffix "diary-lib" (n))
@@ -306,14 +308,17 @@ The hash table is created on first use.")
"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))
+ (record-func (if (fboundp 'bbdb-record-xfield)
+ 'bbdb-record-xfield
+ 'bbdb-record-note))
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)))
+ (funcall record-func
+ rec org-bbdb-anniversary-field)))
(setq annivs (if old-bbdb
(bbdb-split annivs "\n")
;; parameter order is reversed in new bbdb
diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el
index 6ed6abc42b..1f71d91ae9 100644
--- a/lisp/org/org-bibtex.el
+++ b/lisp/org/org-bibtex.el
@@ -2,10 +2,10 @@
;;
;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
;;
-;; Authors: Bastien Guerry <bzg at altern dot org>
+;; Authors: Bastien Guerry <[email protected]>
;; Carsten Dominik <carsten dot dominik at gmail dot com>
;; Eric Schulte <schulte dot eric at gmail dot com>
-;; Keywords: org, wp, remember
+;; Keywords: org, wp, capture
;;
;; This file is part of GNU Emacs.
;;
@@ -31,7 +31,7 @@
;; 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.
+;; capture templates can access and enter this information easily.
;;
;; The available properties for each entry are listed here:
;;
@@ -41,14 +41,14 @@
;; :booktitle :month :annote :abstract
;; :key :btype
;;
-;; Here is an example of a remember template that use some of this
+;; Here is an example of a capture template that use some of this
;; information (:author :year :title :journal :pages):
;;
-;; (setq org-remember-templates
+;; (setq org-capure-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:
+;; Let's say you want to capture this BibTeX entry:
;;
;; @Article{dolev83,
;; author = {Danny Dolev and Andrew C. Yao},
@@ -61,7 +61,7 @@
;; month = {Mars}
;; }
;;
-;; M-x `org-remember' on this entry will produce this buffer:
+;; M-x `org-capture' on this entry will produce this buffer:
;;
;; =====================================================================
;; * READ <== [point here]
@@ -94,7 +94,7 @@
;;
;; The link creation part has been part of Org-mode for a long time.
;;
-;; Creating better remember template information was inspired by a request
+;; Creating better capture template information was inspired by a request
;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112
;; and then implemented by Bastien Guerry.
;;
@@ -224,7 +224,9 @@
For example setting to 'BIB_' would allow interoperability with fireforg."
:group 'org-bibtex
:version "24.1"
- :type 'string)
+ :type '(choice
+ (const nil)
+ (string)))
(defcustom org-bibtex-treat-headline-as-title t
"Treat headline text as title if title property is absent.
@@ -623,6 +625,27 @@ This uses `bibtex-parse-entry'."
(save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
org-bibtex-entries)))
+(defun org-bibtex-read-buffer (buffer)
+ "Read all bibtex entries in BUFFER and save to `org-bibtex-entries'.
+Return the number of saved entries."
+ (interactive "bbuffer: ")
+ (let ((start-length (length org-bibtex-entries)))
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-max))
+ (while (not (= (point) (point-min)))
+ (backward-char 1)
+ (org-bibtex-read)
+ (bibtex-beginning-of-entry))))
+ (let ((added (- (length org-bibtex-entries) start-length)))
+ (message "parsed %d entries" added)
+ added)))
+
+(defun org-bibtex-read-file (file)
+ "Read FILE with `org-bibtex-read-buffer'."
+ (interactive "ffile: ")
+ (org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile)))
+
(defun org-bibtex-write ()
"Insert a heading built from the first element of `org-bibtex-entries'."
(interactive)
@@ -664,6 +687,14 @@ This uses `bibtex-parse-entry'."
(org-bibtex-write)
(error "Yanked text does not appear to contain a BibTeX entry"))))
+(defun org-bibtex-import-from-file (file)
+ "Read bibtex entries from FILE and insert as Org-mode headlines after point."
+ (interactive "ffile: ")
+ (dotimes (_ (org-bibtex-read-file file))
+ (save-excursion (org-bibtex-write))
+ (re-search-forward org-property-end-re)
+ (open-line 1) (forward-char 1)))
+
(defun org-bibtex-export-to-kill-ring ()
"Export current headline to kill ring as bibtex entry."
(interactive)
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index 8a271b8d05..39804ac3c0 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -24,14 +24,14 @@
;;
;;; Commentary:
-;; This file contains an alternative implementation of the same functionality
-;; that is also provided by org-remember.el. The implementation is more
+;; This file contains an alternative implementation of the functionality
+;; that used to be 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.
+;; Wales). John Wiegley's excellent `remember.el' is not needed anymore
+;; 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.
@@ -50,7 +50,6 @@
(eval-when-compile
(require 'cl))
(require 'org)
-(require 'org-mks)
(declare-function org-datetree-find-date-create "org-datetree"
(date &optional keep-restriction))
@@ -182,6 +181,8 @@ properties are:
template only needs information that can be added
automatically.
+ :jump-to-captured When set, jump to the captured entry when finished.
+
: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.
@@ -223,7 +224,9 @@ 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.
+ %(sexp) Evaluate elisp `(sexp)' and replace it with the results.
+ For convenience, %:keyword (see below) placeholders within
+ the expression will be expanded prior to this.
%<...> The result of format-time-string on the ... format specification.
%t Time stamp, date only.
%T Time stamp with date and time.
@@ -237,7 +240,7 @@ be replaced with content and expanded in this order:
%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').
+ %n User name (taken from the variable `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.
@@ -338,11 +341,15 @@ calendar | %:type %:date"
;; Give the most common options as checkboxes
:options (((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
+ ((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
+ ((const :format "%v " :empty-lines-before) (const 1))
+ ((const :format "%v " :empty-lines-after) (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 " :table-line-pos) (const t))
((const :format "%v " :kill-buffer) (const t))))))))
(defcustom org-capture-before-finalize-hook nil
@@ -439,6 +446,7 @@ Turning on this mode runs the normal hook `org-capture-mode-hook'."
;;;###autoload
(defun org-capture-string (string &optional keys)
+ "Capture STRING with the template selected by KEYS."
(interactive "sInitial text: \n")
(let ((org-capture-initial string)
(org-capture-entry (org-capture-select-template keys)))
@@ -459,6 +467,8 @@ Here are the available contexts definitions:
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
+ in-buffer: command displayed only in matching buffers
+not-in-buffer: command not displayed in matching buffers
[function]: a custom function taking no argument
If you define several checks, the agenda command will be
@@ -484,6 +494,8 @@ to avoid duplicates.)"
(choice
(const :tag "In file" in-file)
(const :tag "Not in file" not-in-file)
+ (const :tag "In buffer" in-buffer)
+ (const :tag "Not in buffer" not-in-buffer)
(const :tag "In mode" in-mode)
(const :tag "Not in mode" not-in-mode))
(regexp))
@@ -491,7 +503,7 @@ to avoid duplicates.)"
(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]]."
+When nil, you can still capture using the date at point with \\[org-agenda-capture]."
:group 'org-capture
:version "24.3"
:type 'boolean)
@@ -514,17 +526,19 @@ 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
+ELisp 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."
+agenda will use the date at point as the default date. Then, a
+`C-1' prefix will tell the capture process to use the HH:MM time
+of the day at point (if any) or the current HH:MM time."
(interactive "P")
(when (and org-capture-use-agenda-date
(eq major-mode 'org-agenda-mode))
(setq org-overriding-default-time
- (org-get-cursor-date)))
+ (org-get-cursor-date (equal goto 1))))
(cond
((equal goto '(4)) (org-capture-goto-target))
((equal goto '(16)) (org-capture-goto-last-stored))
@@ -563,8 +577,9 @@ agenda will use the date at point as the default date."
(file-name-nondirectory
(buffer-file-name orig-buf)))
:annotation annotation
- :initial initial)
- (org-capture-put :default-time
+ :initial initial
+ :return-to-wconf (current-window-configuration)
+ :default-time
(or org-overriding-default-time
(org-current-time)))
(org-capture-set-target-location)
@@ -579,7 +594,8 @@ agenda will use the date at point as the default date."
;;insert at point
(org-capture-insert-template-here)
(condition-case error
- (org-capture-place-template)
+ (org-capture-place-template
+ (equal (car (org-capture-get :target)) 'function))
((error quit)
(if (and (buffer-base-buffer (current-buffer))
(string-match "\\`CAPTURE-" (buffer-name)))
@@ -600,7 +616,7 @@ agenda will use the date at point as the default date."
(error
"Could not start the clock in this capture buffer")))
(if (org-capture-get :immediate-finish)
- (org-capture-finalize nil)))))))))
+ (org-capture-finalize)))))))))
(defun org-capture-get-template ()
"Get the template from a file or a function if necessary."
@@ -625,6 +641,8 @@ agenda will use the date at point as the default date."
With prefix argument STAY-WITH-CAPTURE, jump to the location of the
captured item after finalizing."
(interactive "P")
+ (when (org-capture-get :jump-to-captured)
+ (setq stay-with-capture t))
(unless (and org-capture-mode
(buffer-base-buffer (current-buffer)))
(error "This does not seem to be a capture buffer for Org-mode"))
@@ -771,14 +789,14 @@ already gone. Any prefix argument will be passed to the refile command."
(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)))))))
+ (call-interactively 'org-refile)))))
+ (org-capture-finalize)))
(defun org-capture-kill ()
"Abort the current capture process."
@@ -893,7 +911,8 @@ Store them in the capture property list."
(current-time))))
(org-capture-put
:default-time
- (cond ((and (not org-time-was-given)
+ (cond ((and (or (not (boundp 'org-time-was-given))
+ (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)))))
@@ -964,14 +983,17 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(find-file-noselect (expand-file-name file org-directory)))))
(defun org-capture-steal-local-variables (buffer)
- "Install Org-mode local variables."
+ "Install Org-mode local variables of BUFFER."
(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))
+(defun org-capture-place-template (&optional inhibit-wconf-store)
+ "Insert the template at the target location, and display the buffer.
+When `inhibit-wconf-store', don't store the window configuration, as it
+may have been stored before."
+ (unless inhibit-wconf-store
+ (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"))
@@ -1250,8 +1272,11 @@ Of course, if exact position has been required, just put it there."
(save-restriction
(widen)
(goto-char pos)
- (with-demoted-errors
- (bookmark-set "org-capture-last-stored"))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
(move-marker org-capture-last-stored-marker (point)))))))
(defun org-capture-narrow (beg end)
@@ -1261,7 +1286,7 @@ Of course, if exact position has been required, just put it there."
(goto-char beg)))
(defun org-capture-empty-lines-before (&optional n)
- "Arrange for the correct number of empty lines before the insertion point.
+ "Set 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))
@@ -1271,7 +1296,7 @@ Point will be after the empty lines, so insertion can directly be done."
(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.
+ "Set 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))
@@ -1284,6 +1309,7 @@ Point will remain at the first line after the inserted text."
(defvar org-clock-marker) ; Defined in org.el
(defun org-capture-insert-template-here ()
+ "Insert the capture template at point."
(let* ((template (org-capture-get :template))
(type (org-capture-get :type))
beg end pp)
@@ -1366,8 +1392,106 @@ Use PREFIX as a prefix for the name of the indirect buffer."
(unless (org-kill-is-subtree-p tree)
(error "Template is not a valid Org entry or tree")))
-;;; The template code
+(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
+ cursor-type 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)))
+ (let (case-fold-search)
+ (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))
+;;; 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."
@@ -1496,10 +1620,8 @@ The template may still contain \"%?\" for cursor positioning."
(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)))
+ (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "")
+ t t)))
;; From the property list
(when plist-p
@@ -1515,8 +1637,7 @@ The template may still contain \"%?\" for cursor positioning."
(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)))
+ (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
(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)))
@@ -1621,9 +1742,29 @@ The template may still contain \"%?\" for cursor positioning."
(goto-char (match-beginning 0))
(let ((template-start (point)))
(forward-char 1)
- (let ((result (org-eval (read (current-buffer)))))
+ (let* ((sexp (read (current-buffer)))
+ (result (org-eval
+ (org-capture--expand-keyword-in-embedded-elisp sexp))))
(delete-region template-start (point))
- (insert result))))))
+ (when result
+ (if (stringp result)
+ (insert result)
+ (error "Capture template sexp `%s' must evaluate to string or nil"
+ sexp))))))))
+
+(defun org-capture--expand-keyword-in-embedded-elisp (attr)
+ "Recursively replace capture link keywords in ATTR sexp.
+Such keywords are prefixed with \"%:\". See
+`org-capture-template' for more information."
+ (cond ((consp attr)
+ (mapcar 'org-capture--expand-keyword-in-embedded-elisp attr))
+ ((symbolp attr)
+ (let* ((attr-symbol (symbol-name attr))
+ (key (and (string-match "%\\(:.*\\)" attr-symbol)
+ (intern (match-string 1 attr-symbol)))))
+ (or (plist-get org-store-link-plist key)
+ attr)))
+ (t attr)))
(defun org-capture-inside-embedded-elisp-p ()
"Return non-nil if point is inside of embedded elisp %(sexp)."
@@ -1643,7 +1784,7 @@ The template may still contain \"%?\" for cursor positioning."
;;;###autoload
(defun org-capture-import-remember-templates ()
- "Set org-capture-templates to be similar to `org-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? ")
@@ -1660,7 +1801,7 @@ The template may still contain \"%?\" for cursor positioning."
(position (or (nth 4 entry) org-remember-default-headline))
(type 'entry)
(prepend org-reverse-note-order)
- immediate target)
+ immediate target jump-to-captured)
(cond
((member position '(top bottom))
(setq target (list 'file file)
@@ -1674,9 +1815,13 @@ The template may still contain \"%?\" for cursor positioning."
(setq template (replace-match "" t t template)
immediate t))
+ (when (string-match "%&" template)
+ (setq jump-to-captured t))
+
(append (list key desc type target template)
(if prepend '(:prepend t))
- (if immediate '(:immediate-finish t)))))
+ (if immediate '(:immediate-finish t))
+ (if jump-to-captured '(:jump-to-captured t)))))
org-remember-templates))))
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index a536d025c0..9f2256286b 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -26,11 +26,11 @@
;; This file contains the time clocking code for Org-mode
-(require 'org-exp)
;;; Code:
(eval-when-compile
(require 'cl))
+(require 'org)
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
@@ -95,6 +95,24 @@ clocking out."
(repeat :tag "State list"
(string :tag "TODO keyword"))))
+(defcustom org-clock-rounding-minutes 0
+ "Rounding minutes when clocking in or out.
+The default value is 0 so that no rounding is done.
+When set to a non-integer value, use the car of
+`org-time-stamp-rounding-minutes', like for setting a time-stamp.
+
+E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47
+and you clock in: then the clock starts at 14:45. If you clock
+out within the next 5 minutes, the clock line will be removed;
+if you clock out 8 minutes after your clocked in, the clock
+out time will be 14:50."
+ :group 'org-clock
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (integer :tag "Minutes (0 for no rounding)")
+ (symbol :tag "Use `org-time-stamp-rounding-minutes'" 'same-as-time-stamp)))
+
(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
@@ -141,7 +159,7 @@ state to switch it to."
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)
+ :type '(choice (const nil) (function)))
(defcustom org-clock-string-limit 0
"Maximum length of clock strings in the mode line. 0 means no limit."
@@ -177,7 +195,7 @@ Emacs initialization file."
(const :tag "No persistence" nil)))
(defcustom org-clock-persist-file (convert-standard-filename
- "~/.emacs.d/org-clock-save.el")
+ (concat user-emacs-directory "org-clock-save.el"))
"File to save clock data to."
:group 'org-clock
:type 'string)
@@ -193,17 +211,17 @@ Emacs initialization file."
:type 'boolean)
(defcustom org-clock-sound nil
- "Sound that will used for notifications.
-Possible values:
+ "Sound to use for notifications.
+Possible values are:
-nil no sound played.
-t standard Emacs beep
-file name play this sound file. If not possible, fall back to beep"
+nil No sound played
+t Standard Emacs beep
+file name Play this sound file, fall back to beep"
:group 'org-clock
:type '(choice
(const :tag "No sound" nil)
(const :tag "Standard beep" t)
- (file :tag "Play sound file")))
+ (file :tag "Play sound file")))
(define-obsolete-variable-alias 'org-clock-modeline-total
'org-clock-mode-line-total "24.3")
@@ -226,7 +244,7 @@ auto Automatically, either `all', or `repeat' for repeating tasks"
(const :tag "All task time" all)
(const :tag "Automatically, `all' or since `repeat'" auto)))
-(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
+(org-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
@@ -245,6 +263,7 @@ The function or program will be called with the notification
string as argument."
:group 'org-clock
:type '(choice
+ (const nil)
(string :tag "Program")
(function :tag "Function")))
@@ -256,9 +275,11 @@ string as argument."
(defcustom org-clocktable-defaults
(list
:maxlevel 2
- :lang org-export-default-language
+ :lang (or (org-bound-and-true-p org-export-default-language) "en")
:scope 'file
:block nil
+ :wstart 1
+ :mstart 1
:tstart nil
:tend nil
:step nil
@@ -341,13 +362,13 @@ play with them."
"Format string for the total time cells."
:group 'org-clock
:version "24.1"
- :type 'boolean)
+ :type 'string)
(defcustom org-clock-file-time-cell-format "*%s*"
"Format string for the file time cells."
:group 'org-clock
:version "24.1"
- :type 'boolean)
+ :type 'string)
(defcustom org-clock-clocked-in-display 'mode-line
"When clocked in for a task, org-mode can display the current
@@ -378,6 +399,20 @@ specifications than `frame-title-format', which see."
:group 'org-clock
:type 'sexp)
+(defcustom org-clock-x11idle-program-name "x11idle"
+ "Name of the program which prints X11 idle time in milliseconds.
+
+You can find x11idle.c in the contrib/scripts directory of the
+Org git distribution. Or, you can do:
+
+ sudo apt-get install xprintidle
+
+if you are using Debian."
+ :group 'org-clock
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
This hook is run before anything happens to the task that
@@ -403,7 +438,6 @@ to add an effort property.")
(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
@@ -481,46 +515,55 @@ of a different task.")
"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."
+ "Select a task that was recently 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))))))
+ (let (och chl sel-list rpl (i 0) s)
+ ;; Remove successive dups from the clock history to consider
+ (mapc (lambda (c) (if (not (equal c (car och))) (push c och)))
+ org-clock-history)
+ (setq och (reverse och) chl (length och))
+ (if (zerop chl)
+ (user-error "No recent clock")
+ (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)))
+ och)
+ (run-hooks 'org-clock-before-select-task-hook)
+ (goto-char (point-min))
+ ;; Set min-height relatively to circumvent a possible but in
+ ;; `fit-window-to-buffer'
+ (fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl)))
+ (message (or prompt "Select task for clocking:"))
+ (setq cursor-type nil rpl (read-char-exclusive))
+ (cond
+ ((eq rpl ?q) nil)
+ ((eq rpl ?x) nil)
+ ((assoc rpl sel-list) (cdr (assoc rpl sel-list)))
+ (t (user-error "Invalid task choice %c" rpl)))))))
(defun org-clock-insert-selection-line (i marker)
"Insert a line for the clock selection menu.
@@ -547,7 +590,7 @@ pointing to it."
org-odd-levels-only)
(length prefix)))))))
(when (and cat task)
- (insert (format "[%c] %-15s %s\n" i cat task))
+ (insert (format "[%c] %-12s %s\n" i cat task))
(cons i marker)))))
(defvar org-clock-task-overrun nil
@@ -560,30 +603,33 @@ pointing to it."
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))))
+ (let ((clocked-time (org-clock-get-clocked-time)))
(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)
+ (org-minutes-to-clocksum-string clocked-time)
'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))
+ (effort-str (org-minutes-to-clocksum-string effort-in-minutes))
(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)
+ (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time)
+ (format " (%s)" org-clock-heading) "]")
'face 'org-mode-line-clock))))
+(defun org-clock-get-last-clock-out-time ()
+ "Get the last clock-out time for the current subtree."
+ (save-excursion
+ (let ((end (save-excursion (org-end-of-subtree))))
+ (when (re-search-forward (concat org-clock-string
+ ".*\\]--\\(\\[[^]]+\\]\\)") end t)
+ (org-time-string-to-time (match-string 1))))))
+
(defun org-clock-update-mode-line ()
(if org-clock-effort
(org-clock-notify-once-if-expired)
@@ -620,9 +666,12 @@ previous clocking intervals."
"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."
+property will be changed by that amount. If the effort value is expressed
+as an `org-effort-durations' (e.g. \"3h\"), the modificied value will be
+converted to a hh:mm duration.
+
+This command will update the \"Effort\" property of the currently
+clocked item, and the value displayed in the mode line."
(interactive)
(if (org-clock-is-active)
(let ((current org-clock-effort) sign)
@@ -646,7 +695,7 @@ the mode line."
(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-clock-effort (org-minutes-to-clocksum-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))
@@ -669,13 +718,14 @@ Notification is shown only once."
(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))
+ org-clock-heading org-clock-effort) org-clock-sound))
(setq org-clock-notification-was-shown nil)))))
(defun org-notify (notification &optional play-sound)
- "Send a NOTIFICATION and maybe PLAY-SOUND."
+ "Send a NOTIFICATION and maybe PLAY-SOUND.
+If PLAY-SOUND is non-nil, it overrides `org-clock-sound'."
(org-show-notification notification)
- (if play-sound (org-clock-play-sound)))
+ (if play-sound (org-clock-play-sound play-sound)))
(defun org-show-notification (notification)
"Show notification.
@@ -700,21 +750,23 @@ use libnotify if available, or fall back on a message."
;; a fall back option
(t (message "%s" notification))))
-(defun org-clock-play-sound ()
+(defun org-clock-play-sound (&optional clock-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)))))))))
+Use alsa's aplay tool if available.
+If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
+ (let ((org-clock-sound (or clock-sound org-clock-sound)))
+ (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.")
@@ -887,19 +939,23 @@ was started."
(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.
+i/q 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
@@ -1010,13 +1066,13 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(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)
+ (eq (call-process-shell-command "command" nil nil nil "-v" org-clock-x11idle-program-name) 0)
;; Check that x11idle can retrieve the idle time
- (eq (call-process-shell-command "x11idle" nil nil nil) 0)))
+ (eq (call-process-shell-command org-clock-x11idle-program-name 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))
+ (/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000))
(defun org-user-idle-seconds ()
"Return the number of seconds the user has been idle for.
@@ -1037,7 +1093,7 @@ 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)
+ org-clock-marker (marker-buffer org-clock-marker))
(let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
(org-clock-user-idle-start
(time-subtract (current-time)
@@ -1056,16 +1112,7 @@ so long."
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-current-task nil "Task currently clocked in.")
(defvar org-clock-out-time nil) ; store the time of the last clock-out
;;;###autoload
@@ -1156,14 +1203,9 @@ make this the default behavior.)"
(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
- (run-hooks 'org-clock-in-prepare-hook)
- (org-clock-history-push))
- (org-clock-set-current)
+ (run-hooks 'org-clock-in-prepare-hook)
+ (org-clock-history-push)
+ (setq org-clock-current-task (nth 4 (org-heading-components)))
(cond ((functionp org-clock-in-switch-to-state)
(looking-at org-complex-heading-regexp)
(let ((newstate (funcall org-clock-in-switch-to-state
@@ -1174,23 +1216,15 @@ make this the default behavior.)"
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))
+ ((nth 4 (org-heading-components))
(replace-regexp-in-string
"\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1"
- (match-string 4)))
+ (match-string-no-properties 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
@@ -1233,11 +1267,12 @@ make this the default behavior.)"
(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
+ (org-current-time org-clock-rounding-minutes t))
(org-float-time leftover)) 60)))
leftover)
start-time
- (current-time)))
+ (org-current-time org-clock-rounding-minutes t)))
(setq ts (org-insert-time-stamp org-clock-start-time
'with-hm 'inactive))))
(move-marker org-clock-marker (point) (buffer-base-buffer))
@@ -1288,8 +1323,9 @@ for a todo state to switch to, overriding the existing value
(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))))
+ (or org-clock-out-time
+ (org-current-time org-clock-rounding-minutes t))
+ (org-current-time org-clock-rounding-minutes t))))
(if (null org-clock-history)
(message "No last clock")
(let ((org-clock-in-switch-to-state
@@ -1461,7 +1497,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
org-todo-keywords-1)
nil t "DONE")
org-clock-out-switch-to-state))
- (now (current-time))
+ (now (org-current-time org-clock-rounding-minutes))
ts te s h m remove)
(setq org-clock-out-time now)
(save-excursion ; Do not replace this with `with-current-buffer'.
@@ -1522,11 +1558,20 @@ to, overriding the existing value of `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)
+ (message (concat "Clock stopped at %s after "
+ (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s")
+ te (if remove " => LINE REMOVED" ""))
+ (let ((h org-clock-out-hook))
+ ;; If a closing note needs to be stored in the drawer
+ ;; where clocks are stored, let's temporarily disable
+ ;; `org-clock-remove-empty-clock-drawer'
+ (if (and (equal org-clock-into-drawer org-log-into-drawer)
+ (eq org-log-done 'note)
+ org-clock-out-when-done)
+ (setq h (delq 'org-clock-remove-empty-clock-drawer h)))
+ (mapc (lambda (f) (funcall f)) h))
(unless (org-clocking-p)
- (org-clock-delete-current)))))))
+ (setq org-clock-current-task nil)))))))
(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer)
@@ -1545,19 +1590,22 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(org-remove-empty-drawer-at clock-drawer (point))
(forward-line 1))))))
-(defun org-clock-timestamps-up nil
- "Increase CLOCK timestamps at cursor."
- (interactive)
- (org-clock-timestamps-change 'up))
+(defun org-clock-timestamps-up (&optional n)
+ "Increase CLOCK timestamps at cursor.
+Optional argument N tells to change by that many units."
+ (interactive "P")
+ (org-clock-timestamps-change 'up n))
-(defun org-clock-timestamps-down nil
- "Increase CLOCK timestamps at cursor."
- (interactive)
- (org-clock-timestamps-change 'down))
+(defun org-clock-timestamps-down (&optional n)
+ "Increase CLOCK timestamps at cursor.
+Optional argument N tells to change by that many units."
+ (interactive "P")
+ (org-clock-timestamps-change 'down n))
-(defun org-clock-timestamps-change (updown)
+(defun org-clock-timestamps-change (updown &optional n)
"Change CLOCK timestamps synchronously at cursor.
-UPDOWN tells whether to change 'up or 'down."
+UPDOWN tells whether to change 'up or 'down.
+Optional argument N tells to change by that many units."
(setq org-ts-what nil)
(when (org-at-timestamp-p t)
(let ((tschange (if (eq updown 'up) 'org-timestamp-up
@@ -1573,9 +1621,9 @@ UPDOWN tells whether to change 'up or 'down."
(if (<= begts2 (point)) (setq updatets1 t))
(if (not ts2)
;; fall back on org-timestamp-up if there is only one
- (funcall tschange)
+ (funcall tschange n)
;; setq this so that (boundp 'org-ts-what is non-nil)
- (funcall tschange)
+ (funcall tschange n)
(let ((ts (if updatets1 ts2 ts1))
(begts (if updatets1 begts1 begts2)))
(setq tdiff
@@ -1620,6 +1668,12 @@ UPDOWN tells whether to change 'up or 'down."
(message "Clock canceled")
(run-hooks 'org-clock-cancel-hook))
+(defcustom org-clock-goto-before-context 2
+ "Number of lines of context to display before currently clocked-in entry.
+This applies when using `org-clock-goto'."
+ :group 'org-clock
+ :type 'integer)
+
;;;###autoload
(defun org-clock-goto (&optional select)
"Go to the currently clocked-in entry, or to the most recently clocked one.
@@ -1643,7 +1697,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(org-show-entry)
(org-back-to-heading t)
(org-cycle-hide-drawers 'children)
- (recenter)
+ (recenter org-clock-goto-before-context)
(org-reveal)
(if recent
(message "No running clock, this is the most recently clocked task"))
@@ -1669,7 +1723,7 @@ 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)
- (org-unmodified
+ (org-with-silent-modifications
(let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
org-clock-string
"[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)"))
@@ -1784,12 +1838,9 @@ Use \\[org-clock-remove-overlays] to remove the subtree times."
(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))))
+ (message (concat "Total file time: "
+ (org-minutes-to-clocksum-string org-clock-file-total-minutes)
+ " (%d hours and %d minutes)") h m)))
(defvar org-clock-overlays nil)
(make-variable-buffer-local 'org-clock-overlays)
@@ -1801,9 +1852,6 @@ 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)
@@ -1812,14 +1860,9 @@ will be easy to remove."
(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) ?\ )))
+ (org-add-props (concat (make-string l ?*) " "
+ (org-minutes-to-clocksum-string time)
+ (make-string (- 16 l) ?\ ))
(list 'face 'org-clock-overlay))
""))
(if (not (featurep 'xemacs))
@@ -1969,20 +2012,27 @@ buffer and update it."
((> startday 4)
(list 39 startday year)))))))
-(defun org-clock-special-range (key &optional time as-strings)
+(defun org-clock-special-range (key &optional time as-strings wstart mstart)
"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.
+By default, a week starts Monday 0:00 and ends Sunday 24:00.
+The range is determined relative to TIME, which defaults to 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."
+returned by `current time' or `encode-time'.
+If AS-STRINGS is non-nil, the returned times will be formatted strings.
+If WSTART is non-nil, use this number to specify the starting day of a
+week (monday is 1).
+If MSTART is non-nil, use this number to specify the starting day of a
+month (1 is the first day of the month).
+If you can combine both, the month starting day will have priority."
(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))
+ (ws (or wstart 1))
+ (ms (or mstart 1))
(skey (symbol-name key))
(shift 0)
(q (cond ((>= (nth 4 tm) 10) 4)
@@ -2037,20 +2087,21 @@ the returned times will be formatted strings."
((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)))
+ (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))
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))
+ (setq d (or ms 1) h 0 m 0 d1 (or ms 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
+ ;; 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))
+ ;; 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
+ ;; Due to the use of floor, 0 quarters actually means 4.
(if (= 0 (nth 1 tmp))
(setq shiftedy (- y (nth 0 tmp))
shiftedm 1
@@ -2080,8 +2131,7 @@ the returned times will be formatted strings."
((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))))
- )
+ (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))))
@@ -2186,6 +2236,8 @@ the currently selected interval size."
(te (plist-get params :tend))
(link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
+ (ws (plist-get params :wstart))
+ (ms (plist-get params :mstart))
(step (plist-get params :step))
(timestamp (plist-get params :timestamp))
(formatter (or (plist-get params :formatter)
@@ -2196,7 +2248,7 @@ the currently selected interval size."
;; 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)
+ (setq cc (org-clock-special-range block nil t ws ms)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(when step
;; Write many tables, in steps
@@ -2276,7 +2328,8 @@ from the dynamic block definition."
;; well-defined number of columns...
(let* ((hlchars '((1 . "*") (2 . "/")))
(lwords (assoc (or (plist-get params :lang)
- org-export-default-language)
+ (org-bound-and-true-p org-export-default-language)
+ "en")
org-clock-clocktable-language-setup))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
@@ -2284,10 +2337,14 @@ from the dynamic block definition."
(te (plist-get params :tend))
(header (plist-get params :header))
(narrow (plist-get params :narrow))
+ (ws (or (plist-get params :wstart) 1))
+ (ms (or (plist-get params :mstart) 1))
(link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
(emph (plist-get params :emphasize))
(level-p (plist-get params :level))
+ (org-time-clocksum-use-effort-durations
+ (plist-get params :effort-durations))
(timestamp (plist-get params :timestamp))
(properties (plist-get params :properties))
(ntcol (max 1 (or (plist-get params :tcolumns) 100)))
@@ -2326,7 +2383,7 @@ from the dynamic block definition."
(when block
;; Get the range text for the header
- (setq range-text (nth 2 (org-clock-special-range block nil t))))
+ (setq range-text (nth 2 (org-clock-special-range block nil t ws ms))))
;; Compute the total time
(setq total-time (apply '+ (mapcar 'cadr tables)))
@@ -2339,13 +2396,14 @@ from the dynamic block definition."
(or header
;; Format the standard header
(concat
+ "#+CAPTION: "
(nth 9 lwords) " ["
(substring
(format-time-string (cdr org-time-stamp-formats))
1 -1)
"]"
(if block (concat ", for " range-text ".") "")
- "\n\n")))
+ "\n")))
;; Insert the narrowing line
(when (and narrow (integerp narrow) (not narrow-cut-p))
@@ -2378,7 +2436,7 @@ from the dynamic block definition."
(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
+ (org-minutes-to-clocksum-string (or total-time 0))) ; the time
"|\n") ; close line
;; Now iterate over the tables and insert the data
@@ -2402,7 +2460,7 @@ from the dynamic block definition."
(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
+ (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time
;; Get the list of node entries and iterate over it
(setq entries (nth 2 tbl))
@@ -2435,7 +2493,7 @@ from the dynamic block definition."
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
+ hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time
"|\n" ; close line
)))))
;; When exporting subtrees or regions the region might be
@@ -2508,13 +2566,15 @@ from the dynamic block definition."
(let* ((p1 (copy-sequence params))
(ts (plist-get p1 :tstart))
(te (plist-get p1 :tend))
+ (ws (plist-get p1 :wstart))
+ (ms (plist-get p1 :mstart))
(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)
+ cc range-text step-time tsb)
(when block
- (setq cc (org-clock-special-range block nil t)
+ (setq cc (org-clock-special-range block nil t ws ms)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(cond
((numberp ts)
@@ -2532,17 +2592,21 @@ from the dynamic block definition."
(te
(setq te (org-float-time
(apply 'encode-time (org-parse-time-string te))))))
+ (setq tsb
+ (if (eq step0 'week)
+ (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws)))
+ ts))
(setq p1 (plist-put p1 :header ""))
(setq p1 (plist-put p1 :step nil))
(setq p1 (plist-put p1 :block nil))
- (while (< ts te)
+ (while (< tsb te)
(or (bolp) (insert "\n"))
(setq p1 (plist-put p1 :tstart (format-time-string
(org-time-stamp-format nil t)
- (seconds-to-time ts))))
+ (seconds-to-time (max tsb ts)))))
(setq p1 (plist-put p1 :tend (format-time-string
(org-time-stamp-format nil t)
- (seconds-to-time (setq ts (+ ts step))))))
+ (seconds-to-time (min te (setq tsb (+ tsb step)))))))
(insert "\n" (if (eq step0 'day) "Daily report: "
"Weekly report starting on: ")
(plist-get p1 :tstart) "\n")
@@ -2584,6 +2648,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(timestamp (plist-get params :timestamp))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
+ (ws (plist-get params :wstart))
+ (ms (plist-get params :mstart))
(block (plist-get params :block))
(link (plist-get params :link))
(tags (plist-get params :tags))
@@ -2595,7 +2661,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(setq org-clock-file-total-minutes nil)
(when block
- (setq cc (org-clock-special-range block nil t)
+ (setq cc (org-clock-special-range block nil t ws ms)
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)))
@@ -2605,9 +2671,9 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(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)))))
+ (seconds-to-time (org-matcher-time ts)))))
(if te (setq te (org-float-time
- (apply 'encode-time (org-parse-time-string te)))))
+ (seconds-to-time (org-matcher-time te)))))
(save-excursion
(org-clock-sum ts te
(unless (null matcher)
@@ -2751,9 +2817,7 @@ The details of what will be saved are regulated by the variable
(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)
- ") "))))
+ org-clock-heading ") "))))
(insert "(setq resume-clock '(\""
(buffer-file-name (org-clocking-buffer))
"\" . " (int-to-string (marker-position org-clock-marker))
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index 5a59196baa..8790ad45fb 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -36,7 +36,7 @@
(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'"))
+ (error "Do not load this file into XEmacs, use `org-colview-xemacs.el' from the contrib/ directory"))
;;; Column View
@@ -169,8 +169,10 @@ This is the compiled version of the format.")
(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))
+ (font (list :height (face-attribute 'default :height)
+ :family (face-attribute 'default :family)))
+ (face (list color font 'org-column ref-face))
+ (face1 (list color font '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.
@@ -223,7 +225,7 @@ This is the compiled version of the format.")
(setq s2 (org-columns-add-ellipses (or modval val) width))
(setq string (format f s2))
;; Create the overlay
- (org-unmodified
+ (org-with-silent-modifications
(setq ov (org-columns-new-overlay
beg (setq beg (1+ beg)) string (if dateline face1 face)))
(overlay-put ov 'keymap org-columns-map)
@@ -332,7 +334,7 @@ for the duration of the command.")
(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
+ (org-with-silent-modifications
(mapc 'delete-overlay org-columns-overlays)
(setq org-columns-overlays nil)
(let ((inhibit-read-only t))
@@ -384,7 +386,7 @@ CPHR is the complex heading regexp to use for parsing ITEM."
(defun org-columns-quit ()
"Remove the column overlays and in this way exit column editing."
(interactive)
- (org-unmodified
+ (org-with-silent-modifications
(org-columns-remove-overlays)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
@@ -488,7 +490,7 @@ Where possible, use the standard interface for changing this line."
(org-agenda-columns)))
(t
(let ((inhibit-read-only t))
- (org-unmodified
+ (org-with-silent-modifications
(remove-text-properties
(max (point-min) (1- bol)) eol '(read-only t)))
(unwind-protect
@@ -589,9 +591,9 @@ an integer, select that value."
(if (= nth -1) (setq nth 9)))
(when (equal key "ITEM")
(error "Cannot edit item headline from here"))
- (unless (or allowed (member key '("SCHEDULED" "DEADLINE")))
+ (unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")))
(error "Allowed values for this property have not been defined"))
- (if (member key '("SCHEDULED" "DEADLINE"))
+ (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))
(setq nval (if previous 'earlier 'later))
(if previous (setq allowed (reverse allowed)))
(cond
@@ -920,7 +922,7 @@ Don't set this, this is meant for dynamic scoping.")
(defun org-columns-compute-all ()
"Compute all columns that have operators defined."
- (org-unmodified
+ (org-with-silent-modifications
(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)))
@@ -996,7 +998,7 @@ Don't set this, this is meant for dynamic scoping.")
(if (assoc property sum-alist)
(setcdr (assoc property sum-alist) useval)
(push (cons property useval) sum-alist)
- (org-unmodified
+ (org-with-silent-modifications
(add-text-properties sumpos (1+ sumpos)
(list 'org-summaries sum-alist))))
(when (and val (not (equal val (if flag str val))))
@@ -1058,8 +1060,7 @@ Don't set this, this is meant for dynamic scoping.")
((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)))
+ (org-hours-to-clocksum-string n))
((eq fmt 'checkbox)
(cond ((= n (floor n)) "[X]")
((> n 1.) "[-]")
@@ -1305,10 +1306,10 @@ PARAMS is a property list of parameters:
(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")))
+ (setq pos (point))
(insert (org-listtable-to-string tbl))
(when (plist-get params :width)
(insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
@@ -1404,7 +1405,7 @@ and tailing newline characters."
;; 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))
+ (setq d (org-minutes-to-clocksum-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))
@@ -1510,9 +1511,8 @@ This will add overlays to the date lines, to show the summary for each day."
(save-excursion
(save-restriction
(widen)
- (org-unmodified
- (remove-text-properties (point-min) (point-max)
- '(org-summaries t)))
+ (org-with-silent-modifications
+ (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))
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index 9292b99436..b714f13a66 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -113,6 +113,41 @@ any other entries, and any resulting duplicates will be removed entirely."
;;;; Emacs/XEmacs compatibility
+(eval-and-compile
+ (defun org-defvaralias (new-alias base-variable &optional docstring)
+ "Compatibility function for defvaralias.
+Don't do the aliasing when `defvaralias' is not bound."
+ (declare (indent 1))
+ (when (fboundp 'defvaralias)
+ (defvaralias new-alias base-variable docstring)))
+
+ (when (and (not (boundp 'user-emacs-directory))
+ (boundp 'user-init-directory))
+ (org-defvaralias 'user-emacs-directory 'user-init-directory)))
+
+(when (featurep 'xemacs)
+ (defadvice custom-handle-keyword
+ (around org-custom-handle-keyword
+ activate preactivate)
+ "Remove custom keywords not recognized to avoid producing an error."
+ (cond
+ ((eq (ad-get-arg 1) :package-version))
+ (t ad-do-it)))
+ (defadvice define-obsolete-variable-alias
+ (around org-define-obsolete-variable-alias
+ (obsolete-name current-name &optional when docstring)
+ activate preactivate)
+ "Declare arguments defined in later versions of Emacs."
+ ad-do-it)
+ (defadvice define-obsolete-function-alias
+ (around org-define-obsolete-function-alias
+ (obsolete-name current-name &optional when docstring)
+ activate preactivate)
+ "Declare arguments defined in later versions of Emacs."
+ ad-do-it)
+ (defvar customize-package-emacs-version-alist nil)
+ (defvar temporary-file-directory (temp-directory)))
+
;; Keys
(defconst org-xemacs-key-equivalents
'(([mouse-1] . [button1])
@@ -226,7 +261,7 @@ ignored in this case."
;; Region compatibility
(defvar org-ignore-region nil
- "To temporarily disable the active region.")
+ "Non-nil means temporarily disable the active region.")
(defun org-region-active-p ()
"Is `transient-mark-mode' on and the region active?
@@ -300,10 +335,11 @@ Works on both Emacs and 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-move-to-column (column &optional force buffer ignore-invisible)
+ (let ((buffer-invisibility-spec ignore-invisible))
+ (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."
@@ -378,11 +414,11 @@ TIME defaults to the current time."
"Suppress popup windows.
Let-bind some variables to nil around BODY to achieve the desired
effect, which variables to use depends on the Emacs version."
- (if (org-version-check "24.2.50" "" :predicate)
- `(let (pop-up-frames display-buffer-alist)
- ,@body)
- `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
- ,@body)))
+ (if (org-version-check "24.2.50" "" :predicate)
+ `(let (pop-up-frames display-buffer-alist)
+ ,@body)
+ `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
+ ,@body)))
(if (fboundp 'string-match-p)
(defalias 'org-string-match-p 'string-match-p)
@@ -484,6 +520,29 @@ With two arguments, return floor and remainder of their quotient."
(defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!"))))))
+(defun org-file-equal-p (f1 f2)
+ "Return t if files F1 and F2 are the same.
+Implements `file-equal-p' for older emacsen and XEmacs."
+ (if (fboundp 'file-equal-p)
+ (file-equal-p f1 f2)
+ (let (f1-attr f2-attr)
+ (and (setq f1-attr (file-attributes (file-truename f1)))
+ (setq f2-attr (file-attributes (file-truename f2)))
+ (equal f1-attr f2-attr)))))
+
+;; `buffer-narrowed-p' is available for Emacs >=24.3
+(defun org-buffer-narrowed-p ()
+ "Compatibility function for `buffer-narrowed-p'."
+ (if (fboundp 'buffer-narrowed-p)
+ (buffer-narrowed-p)
+ (/= (- (point-max) (point-min)) (buffer-size))))
+
+(defmacro org-with-silent-modifications (&rest body)
+ (if (fboundp 'with-silent-modifications)
+ `(with-silent-modifications ,@body)
+ `(org-unmodified ,@body)))
+(def-edebug-spec org-with-silent-modifications (body))
+
(provide 'org-compat)
;;; org-compat.el ends here
diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el
index 2dfc4addcc..b02a7ceffb 100644
--- a/lisp/org/org-crypt.el
+++ b/lisp/org/org-crypt.el
@@ -139,11 +139,11 @@ See `org-crypt-disable-auto-save'."
(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))
+ (org-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 ()
@@ -264,7 +264,7 @@ See `org-crypt-disable-auto-save'."
"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))))
+ (lambda () (org-add-hook 'before-save-hook 'org-encrypt-entries nil t))))
(add-hook 'org-reveal-start-hook 'org-decrypt-entry)
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index 833c1dd6c1..9d8ed6c62b 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -131,7 +131,7 @@
;;
;; (progn
;; (message "-- rebuilding tags tables...")
-;; (mapc 'org-create-tags tags-table-list))
+;; (mapc 'org-ctags-create-tags tags-table-list))
;;; Code:
@@ -156,11 +156,8 @@ 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."
+ (if (executable-find "ctags-exuberant") "ctags-exuberant" "ctags")
+ "Name of the ctags executable file."
:group 'org-ctags
:version "24.1"
:type 'file)
diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el
index e0f4d10bc2..dd4b1b0e1b 100644
--- a/lisp/org/org-datetree.el
+++ b/lisp/org/org-datetree.el
@@ -72,7 +72,8 @@ tree can be found."
(goto-char (prog1 (point) (widen))))))
(defun org-datetree-find-year-create (year)
- (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)")
+ "Find the YEAR datetree or create it."
+ (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)")
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
@@ -90,6 +91,7 @@ tree can be found."
(org-datetree-insert-line year)))))
(defun org-datetree-find-month-create (year month)
+ "Find the datetree for YEAR and MONTH or create it."
(org-narrow-to-subtree)
(let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year))
match)
@@ -109,6 +111,7 @@ tree can be found."
(org-datetree-insert-line year month)))))
(defun org-datetree-find-day-create (year month day)
+ "Find the datetree for YEAR, MONTH and DAY or create it."
(org-narrow-to-subtree)
(let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month))
match)
diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el
index be99ad99a6..72ccc46d62 100644
--- a/lisp/org/org-docview.el
+++ b/lisp/org/org-docview.el
@@ -51,9 +51,22 @@
(org-autoload "doc-view" '(doc-view-goto-page))
-(org-add-link-type "docview" 'org-docview-open)
+(org-add-link-type "docview" 'org-docview-open 'org-docview-export)
(add-hook 'org-store-link-functions 'org-docview-store-link)
+(defun org-docview-export (link description format)
+ "Export a docview link from Org files."
+ (let* ((path (when (string-match "\\(.+\\)::.+" link)
+ (match-string 1 link)))
+ (desc (or description link)))
+ (when (stringp path)
+ (setq path (org-link-escape (expand-file-name path)))
+ (cond
+ ((eq format 'html) (format "<a href=\"%s\">%s</a>" path desc))
+ ((eq format 'latex) (format "\href{%s}{%s}" path desc))
+ ((eq format 'ascii) (format "%s (%s)" desc path))
+ (t path)))))
+
(defun org-docview-open (link)
(when (string-match "\\(.*\\)::\\([0-9]+\\)$" link)
(let* ((path (match-string 1 link))
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 5be1477196..55efb50084 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -30,25 +30,28 @@
;; 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.
+;; a few exceptions (`clock', `headline', `inlinetask', `item',
+;; `planning', `node-property', `quote-section' `section' and
+;; `table-row' 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'.
+;; `item', `plain-list', `property-drawer', `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.
+;; `comment-block', `diary-sexp', `example-block', `export-block',
+;; `fixed-width', `horizontal-rule', `keyword', `latex-environment',
+;; `node-property', `paragraph', `planning', `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',
@@ -59,7 +62,7 @@
;; `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
+;; objects themselves (i.e. an item tag or a headline name). Such
;; values are called "secondary strings". Any object belongs to
;; either an element or a secondary string.
;;
@@ -69,9 +72,15 @@
;; 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.
+;; refers to the element or object containing it. Greater elements,
+;; elements and objects containing objects will also have
+;; `:contents-begin' and `:contents-end' properties to delimit
+;; contents. Eventually, greater elements and elements accepting
+;; affiliated keywords will have a `:post-affiliated' property,
+;; referring to the buffer position after all such keywords.
+;;
+;; At the lowest level, a `:parent' property is also attached to any
+;; string, as a text property.
;;
;; Lisp-wise, an element or an object can be represented as a list.
;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
@@ -107,11 +116,10 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(eval-when-compile (require 'cl))
(require 'org)
+
;;; Definitions And Rules
;;
@@ -128,6 +136,8 @@
org-outline-regexp "\\|"
;; Footnote definitions.
"\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+ ;; Diary sexps.
+ "%%(" "\\|"
"[ \t]*\\(?:"
;; Empty lines.
"$" "\\|"
@@ -150,7 +160,7 @@
;; Lists.
(let ((term (case org-plain-list-ordered-item-terminator
(?\) ")") (?. "\\.") (otherwise "[.)]")))
- (alpha (and org-alphabetical-lists "\\|[A-Za-z]")))
+ (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
(concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
"\\(?:[ \t]\\|$\\)"))
"\\)\\)")
@@ -160,22 +170,23 @@ 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)
+ '(babel-call center-block clock comment comment-block diary-sexp drawer
+ dynamic-block example-block export-block fixed-width
+ footnote-definition headline horizontal-rule inlinetask item
+ keyword latex-environment node-property 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)
+ item plain-list property-drawer 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
+ latex-or-entity line-break link macro plain-link radio-target
statistics-cookie sub/superscript table-cell target
text-markup timestamp)
"Complete list of successors.")
@@ -187,7 +198,6 @@ is not sufficient to know if point is at a paragraph ending. See
(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.")
@@ -199,11 +209,11 @@ regexp matching one object can also match the other object.")
"Complete list of object types.")
(defconst org-element-recursive-objects
- '(bold italic link macro subscript radio-target strike-through superscript
+ '(bold italic link subscript radio-target strike-through superscript
table-cell underline)
"List of recursive object types.")
-(defconst org-element-block-name-alist
+(defvar org-element-block-name-alist
'(("CENTER" . org-element-center-block-parser)
("COMMENT" . org-element-comment-block-parser)
("EXAMPLE" . org-element-example-block-parser)
@@ -214,6 +224,12 @@ regexp matching one object can also match the other object.")
Names must be uppercase. Any block whose name has no association
is parsed with `org-element-special-block-parser'.")
+(defconst org-element-link-type-is-file
+ '("file" "file+emacs" "file+sys" "docview")
+ "List of link types equivalent to \"file\".
+Only these types can accept search options and an explicit
+application to open them.")
+
(defconst org-element-affiliated-keywords
'("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
"RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
@@ -242,8 +258,8 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
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.
+(defconst org-element-multiple-keywords '("CAPTION" "HEADER")
+ "List of affiliated keywords that can occur more than once in an element.
Their value will be consed into a list of strings, which will be
returned as the value of the property.
@@ -254,8 +270,8 @@ This list is checked after translations have been applied. See
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.
+(defconst org-element-parsed-keywords '("CAPTION")
+ "List of affiliated keywords whose value can be parsed.
Their value will be stored as a secondary string: a list of
strings and objects.
@@ -264,10 +280,10 @@ 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.
+ "List of affiliated 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
+before the colons. For example, RESULTS keyword can be
associated to a hash value with the following:
#+RESULTS[hash-string]: some-source
@@ -275,46 +291,40 @@ associated to a hash value with the following:
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
+(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE")
+ "List of properties associated to the whole document.
+Any keyword in this list will have its value parsed and stored as
+a secondary string.")
+
(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))
+ (let* ((standard-set
+ (remq 'plain-link (remq 'table-cell org-element-all-successors)))
+ (standard-set-no-line-break (remq 'line-break standard-set)))
+ `((bold ,@standard-set)
+ (footnote-reference ,@standard-set)
+ (headline ,@standard-set-no-line-break)
+ (inlinetask ,@standard-set-no-line-break)
+ (italic ,@standard-set)
+ (item ,@standard-set-no-line-break)
+ (keyword ,@standard-set)
+ ;; Ignore all links excepted plain links in a link description.
+ ;; Also ignore radio-targets and line breaks.
+ (link export-snippet inline-babel-call inline-src-block latex-or-entity
+ macro plain-link statistics-cookie sub/superscript text-markup)
+ (paragraph ,@standard-set)
+ ;; Remove any variable object from radio target as it would
+ ;; prevent it from being properly recognized.
+ (radio-target latex-or-entity sub/superscript)
+ (strike-through ,@standard-set)
+ (subscript ,@standard-set)
+ (superscript ,@standard-set)
+ ;; Ignore inline babel call and inline src block as formulas are
+ ;; possible. Also ignore line breaks and statistics cookies.
+ (table-cell export-snippet footnote-reference latex-or-entity link macro
+ radio-target sub/superscript target text-markup timestamp)
+ (table-row table-cell)
+ (underline ,@standard-set)
+ (verse-block ,@standard-set)))
"Alist of objects restrictions.
CAR is an element or object type containing objects and CDR is
@@ -322,8 +332,7 @@ 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.
+entities, latex-fragments, subscript and superscript.
This alist also applies to secondary string. For example, an
`headline' type element doesn't directly contain objects, but
@@ -336,6 +345,11 @@ still has an entry since one of its properties (`:title') does.")
(footnote-reference . :inline-definition))
"Alist between element types and location of secondary value.")
+(defconst org-element-object-variables '(org-link-abbrev-alist-local)
+ "List of buffer-local variables used when parsing objects.
+These variables are copied to the temporary buffer created by
+`org-export-secondary-string'.")
+
;;; Accessors and Setters
@@ -363,11 +377,14 @@ It can also return the following special value:
(defsubst org-element-property (property element)
"Extract the value from the PROPERTY of an ELEMENT."
- (plist-get (nth 1 element) property))
+ (if (stringp element) (get-text-property 0 property element)
+ (plist-get (nth 1 element) property)))
(defsubst org-element-contents (element)
"Extract contents from an ELEMENT."
- (and (consp element) (nthcdr 2 element)))
+ (cond ((not (consp element)) nil)
+ ((symbolp (car element)) (nthcdr 2 element))
+ (t element)))
(defsubst org-element-restriction (element)
"Return restriction associated to ELEMENT.
@@ -379,14 +396,15 @@ element or object type."
(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)
+ (if (stringp element) (org-add-props element nil property value)
+ (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))
+ ((not (symbolp (car element))) contents)
((cdr element) (setcdr (cdr element) contents))
(t (nconc element contents))))
@@ -415,18 +433,18 @@ 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.
+ ;; Link every child to PARENT. If PARENT is nil, it is a secondary
+ ;; string: parent is the list itself.
+ (mapc (lambda (child)
+ (org-element-put-property child :parent (or parent children)))
+ children)
+ ;; Add CHILDREN at the end of PARENT contents.
+ (when parent
(apply 'org-element-set-contents
parent
- (nconc (org-element-contents parent) children))
- ;; Return modified PARENT element.
- parent))
+ (nconc (org-element-contents parent) children)))
+ ;; Return modified PARENT element.
+ (or parent children))
@@ -466,24 +484,27 @@ Return parent element."
;;;; Center Block
-(defun org-element-center-block-parser (limit)
+(defun org-element-center-block-parser (limit affiliated)
"Parse a center block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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.
+`:contents-end', `:post-blank' and `:post-affiliated' 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[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
@@ -493,9 +514,9 @@ Assume point is at the beginning of the block."
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
- (end (save-excursion (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (end (save-excursion
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
(list 'center-block
(nconc
(list :begin begin
@@ -503,8 +524,9 @@ Assume point is at the beginning of the block."
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
(defun org-element-center-block-interpreter (center-block contents)
"Interpret CENTER-BLOCK element as Org syntax.
@@ -514,49 +536,51 @@ CONTENTS is the contents of the element."
;;;; Drawer
-(defun org-element-drawer-parser (limit)
+(defun org-element-drawer-parser (limit affiliated)
"Parse a drawer.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of drawer."
(let ((case-fold-search t))
(if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" 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)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
- (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)))))))))
+ (org-element-paragraph-parser limit affiliated)
+ (save-excursion
+ (let* ((drawer-end-line (match-beginning 0))
+ (name (progn (looking-at org-drawer-regexp)
+ (org-match-string-no-properties 1)))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ ;; 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) (line-beginning-position)))))
+ (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)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
(defun org-element-drawer-interpreter (drawer contents)
"Interpret DRAWER element as Org syntax.
@@ -568,29 +592,32 @@ CONTENTS is the contents of the element."
;;;; Dynamic Block
-(defun org-element-dynamic-block-parser (limit)
+(defun org-element-dynamic-block-parser (limit affiliated)
"Parse a dynamic block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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.
+`:contents-begin', `:contents-end', `:arguments', `:post-blank'
+and `:post-affiliated' keywords.
Assume point is at beginning of dynamic block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(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))
+ (begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
@@ -601,8 +628,7 @@ Assume point is at beginning of dynamic block."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'dynamic-block
(nconc
(list :begin begin
@@ -612,8 +638,9 @@ Assume point is at beginning of dynamic block."
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-dynamic-block-interpreter (dynamic-block contents)
"Interpret DYNAMIC-BLOCK element as Org syntax.
@@ -627,38 +654,43 @@ CONTENTS is the contents of the element."
;;;; Footnote Definition
-(defun org-element-footnote-definition-parser (limit)
+(defun org-element-footnote-definition-parser (limit affiliated)
"Parse a footnote definition.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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.
+`:contents-end', `:post-blank' and `:post-affiliated' 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))
+ (begin (car affiliated))
+ (post-affiliated (point))
(ending (save-excursion
(if (progn
(end-of-line)
(re-search-forward
(concat org-outline-regexp-bol "\\|"
org-footnote-definition-re "\\|"
- "^[ \t]*$") limit 'move))
+ "^\\([ \t]*\n\\)\\{2,\\}") limit 'move))
(match-beginning 0)
(point))))
- (contents-begin (progn (search-forward "]")
- (skip-chars-forward " \r\t\n" ending)
- (and (/= (point) ending) (point))))
+ (contents-begin (progn
+ (search-forward "]")
+ (skip-chars-forward " \r\t\n" ending)
+ (cond ((= (point) ending) nil)
+ ((= (line-beginning-position) begin) (point))
+ (t (line-beginning-position)))))
(contents-end (and contents-begin ending))
(end (progn (goto-char ending)
(skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'footnote-definition
(nconc
(list :label label
@@ -666,8 +698,9 @@ Assume point is at the beginning of the footnote definition."
:end end
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines ending end))
- (cadr keywords))))))
+ :post-blank (count-lines ending end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
@@ -680,19 +713,19 @@ CONTENTS is the contents of the footnote-definition."
;;;; Headline
(defun org-element-headline-parser (limit &optional raw-secondary-p)
- "Parse an headline.
+ "Parse a 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.
+containing `:raw-value', `:title', `:alt-title', `:begin',
+`:end', `:pre-blank', `:hiddenp', `:contents-begin' and
+`:contents-end', `:level', `:priority', `:tags',
+`:todo-keyword',`:todo-type', `:scheduled', `:deadline',
+`:closed', `: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').
+with its name in upper cases and colons added 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.
@@ -718,25 +751,37 @@ Assume point is at beginning of the headline."
(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)))
+ ;; Upcase property names. It avoids confusion between
+ ;; properties obtained through property drawer and default
+ ;; properties from the parser (e.g. `:end' and :END:)
+ (standard-props
+ (let (plist)
+ (mapc
+ (lambda (p)
+ (setq plist
+ (plist-put plist
+ (intern (concat ":" (upcase (car p))))
+ (cdr p))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props
+ ;; Read time properties on the line below the headline.
+ (save-excursion
+ (when (progn (forward-line)
+ (looking-at org-planning-or-clock-line-re))
+ (let ((end (line-end-position)) plist)
+ (while (re-search-forward
+ org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t")
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-scheduled-string)
+ (setq plist (plist-put plist :scheduled time)))
+ ((equal keyword org-deadline-string)
+ (setq plist (plist-put plist :deadline time)))
+ (t (setq plist (plist-put plist :closed time))))))
+ plist))))
(begin (point))
(end (save-excursion (goto-char (org-end-of-subtree t t))))
(pos-after-head (progn (forward-line) (point)))
@@ -778,10 +823,6 @@ Assume point is at beginning of the headline."
: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)
@@ -792,7 +833,15 @@ Assume point is at beginning of the headline."
:archivedp archivedp
:commentedp commentedp
:quotedp quotedp)
+ time-props
standard-props))))
+ (let ((alt-title (org-element-property :ALT_TITLE headline)))
+ (when alt-title
+ (org-element-put-property
+ headline :alt-title
+ (if raw-secondary-p alt-title
+ (org-element-parse-secondary-string
+ alt-title (org-element-restriction 'headline) headline)))))
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
@@ -816,7 +865,7 @@ CONTENTS is the contents of the element."
(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 ?*)
+ (heading (concat (make-string (org-reduced-level level) ?*)
(and todo (concat " " todo))
(and quotedp (concat " " org-quote-string))
(and commentedp (concat " " org-comment-string))
@@ -855,12 +904,11 @@ 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.
+`:scheduled', `:deadline', `:closed' 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').
+with its name in upper cases and colons added 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
@@ -868,8 +916,7 @@ string instead.
Assume point is at beginning of the inline task."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (point))
(components (org-heading-components))
(todo (nth 2 components))
(todo-type (and todo
@@ -877,25 +924,38 @@ Assume point is at beginning of the inline task."
(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)))
+ ;; Upcase property names. It avoids confusion between
+ ;; properties obtained through property drawer and default
+ ;; properties from the parser (e.g. `:end' and :END:)
+ (standard-props
+ (let (plist)
+ (mapc
+ (lambda (p)
+ (setq plist
+ (plist-put plist
+ (intern (concat ":" (upcase (car p))))
+ (cdr p))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props
+ ;; Read time properties on the line below the inlinetask
+ ;; opening string.
+ (save-excursion
+ (when (progn (forward-line)
+ (looking-at org-planning-or-clock-line-re))
+ (let ((end (line-end-position)) plist)
+ (while (re-search-forward
+ org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t")
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-scheduled-string)
+ (setq plist (plist-put plist :scheduled time)))
+ ((equal keyword org-deadline-string)
+ (setq plist (plist-put plist :deadline time)))
+ (t (setq plist (plist-put plist :closed time))))))
+ plist))))
(task-end (save-excursion
(end-of-line)
(and (re-search-forward "^\\*+ END" limit t)
@@ -909,8 +969,7 @@ Assume point is at beginning of the inline task."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))
+ (if (eobp) (point) (line-beginning-position))))
(inlinetask
(list 'inlinetask
(nconc
@@ -925,13 +984,9 @@ Assume point is at beginning of the inline task."
: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)))))
+ time-props
+ standard-props))))
(org-element-put-property
inlinetask :title
(if raw-secondary-p raw-value
@@ -1063,7 +1118,11 @@ Assume point is at the beginning of the 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)))
+ (let* ((bullet (let ((bullet (org-element-property :bullet item)))
+ (org-list-bullet-string
+ (cond ((not (string-match "[0-9a-zA-Z]" bullet)) "- ")
+ ((eq org-plain-list-ordered-item-terminator ?\)) "1)")
+ (t "1.")))))
(checkbox (org-element-property :checkbox item))
(counter (org-element-property :counter item))
(tag (let ((tag (org-element-property :tag item)))
@@ -1082,40 +1141,127 @@ CONTENTS is the contents of the element."
(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))))))
+ (when contents
+ (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)
+(defun org-element--list-struct (limit)
+ ;; Return structure of list at point. Internal function. See
+ ;; `org-list-struct' for details.
+ (let ((case-fold-search t)
+ (top-ind limit)
+ (item-re (org-item-re))
+ (drawers-re (concat ":\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$"))
+ (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
+ items struct)
+ (save-excursion
+ (catch 'exit
+ (while t
+ (cond
+ ;; At limit: end all items.
+ ((>= (point) limit)
+ (throw 'exit
+ (let ((end (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))
+ (dolist (item items (sort (nconc items struct)
+ 'car-less-than-car))
+ (setcar (nthcdr 6 item) end)))))
+ ;; At list end: end all items.
+ ((looking-at org-list-end-re)
+ (throw 'exit (dolist (item items (sort (nconc items struct)
+ 'car-less-than-car))
+ (setcar (nthcdr 6 item) (point)))))
+ ;; At a new item: end previous sibling.
+ ((looking-at item-re)
+ (let ((ind (save-excursion (skip-chars-forward " \t")
+ (current-column))))
+ (setq top-ind (min top-ind ind))
+ (while (and items (<= ind (nth 1 (car items))))
+ (let ((item (pop items)))
+ (setcar (nthcdr 6 item) (point))
+ (push item struct)))
+ (push (progn (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))
+ ;; Ending position, unknown so far.
+ nil)))
+ items))
+ (forward-line 1))
+ ;; Skip empty lines.
+ ((looking-at "^[ \t]*$") (forward-line))
+ ;; Skip inline tasks and blank lines along the way.
+ ((and inlinetask-re (looking-at inlinetask-re))
+ (forward-line)
+ (let ((origin (point)))
+ (when (re-search-forward inlinetask-re limit t)
+ (if (looking-at "^\\*+ END[ \t]*$") (forward-line)
+ (goto-char origin)))))
+ ;; At some text line. Check if it ends any previous item.
+ (t
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (when (<= ind top-ind)
+ (skip-chars-backward " \r\t\n")
+ (forward-line))
+ (while (<= ind (nth 1 (car items)))
+ (let ((item (pop items)))
+ (setcar (nthcdr 6 item) (line-beginning-position))
+ (push item struct)
+ (unless items
+ (throw 'exit (sort struct 'car-less-than-car))))))
+ ;; Skip blocks (any type) and drawers contents.
+ (cond
+ ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
+ (re-search-forward
+ (format "^[ \t]*#\\+END%s[ \t]*$"
+ (org-match-string-no-properties 1))
+ limit t)))
+ ((and (looking-at drawers-re)
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
+ (forward-line))))))))
+
+(defun org-element-plain-list-parser (limit affiliated structure)
"Parse a plain list.
-Optional argument STRUCTURE, when non-nil, is the structure of
-the plain list being parsed.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value. STRUCTURE 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.
+`:contents-end', `:structure', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the list."
(save-excursion
- (let* ((struct (or structure (org-list-struct)))
+ (let* ((struct (or structure (org-element--list-struct limit)))
(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))
+ (begin (car affiliated))
(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)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (= (point) limit) limit (line-beginning-position)))))
;; Return value.
(list 'plain-list
(nconc
@@ -1125,8 +1271,9 @@ Assume point is at the beginning of the list."
:contents-begin contents-begin
:contents-end contents-end
:structure struct
- :post-blank (count-lines contents-end end))
- (cadr keywords))))))
+ :post-blank (count-lines contents-end end)
+ :post-affiliated contents-begin)
+ (cdr affiliated))))))
(defun org-element-plain-list-interpreter (plain-list contents)
"Interpret PLAIN-LIST element as Org syntax.
@@ -1138,27 +1285,82 @@ CONTENTS is the contents of the element."
(buffer-string)))
+;;;; Property Drawer
+
+(defun org-element-property-drawer-parser (limit affiliated)
+ "Parse a property drawer.
+
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
+
+Return a list whose CAR is `property-drawer' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+
+Assume point is at the beginning of the property drawer."
+ (save-excursion
+ (let ((case-fold-search t))
+ (if (not (save-excursion
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
+ ;; Incomplete drawer: parse it as a paragraph.
+ (org-element-paragraph-parser limit affiliated)
+ (save-excursion
+ (let* ((drawer-end-line (match-beginning 0))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ (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) (line-beginning-position)))))
+ (list 'property-drawer
+ (nconc
+ (list :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
+
+(defun org-element-property-drawer-interpreter (property-drawer contents)
+ "Interpret PROPERTY-DRAWER element as Org syntax.
+CONTENTS is the properties within the drawer."
+ (format ":PROPERTIES:\n%s:END:" contents))
+
+
;;;; Quote Block
-(defun org-element-quote-block-parser (limit)
+(defun org-element-quote-block-parser (limit affiliated)
"Parse a quote block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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.
+`:contents-end', `:post-blank' and `:post-affiliated' 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[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
@@ -1169,8 +1371,7 @@ Assume point is at the beginning of the block."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'quote-block
(nconc
(list :begin begin
@@ -1178,8 +1379,9 @@ Assume point is at the beginning of the block."
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-quote-block-interpreter (quote-block contents)
"Interpret QUOTE-BLOCK element as Org syntax.
@@ -1221,28 +1423,33 @@ CONTENTS is the contents of the element."
;;;; Special Block
-(defun org-element-special-block-parser (limit)
+(defun org-element-special-block-parser (limit affiliated)
"Parse a special block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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.
+`:contents-begin', `:contents-end', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let* ((case-fold-search t)
- (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)")
+ (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(upcase (match-string-no-properties 1)))))
(if (not (save-excursion
(re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
+ (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
+ limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
@@ -1253,8 +1460,7 @@ Assume point is at the beginning of the block."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'special-block
(nconc
(list :type type
@@ -1263,8 +1469,9 @@ Assume point is at the beginning of the block."
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-special-block-interpreter (special-block contents)
"Interpret SPECIAL-BLOCK element as Org syntax.
@@ -1290,28 +1497,34 @@ CONTENTS is the contents of the element."
;;;; Babel Call
-(defun org-element-babel-call-parser (limit)
+(defun org-element-babel-call-parser (limit affiliated)
"Parse a babel call.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `babel-call' and CDR is a plist
-containing `:begin', `:end', `:info' and `:post-blank' as
-keywords."
+containing `:begin', `:end', `:info', `:post-blank' and
+`:post-affiliated' 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))
+ (begin (car affiliated))
+ (post-affiliated (point))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'babel-call
- (list :begin begin
- :end end
- :info info
- :post-blank (count-lines pos-before-blank end))))))
+ (nconc
+ (list :begin begin
+ :end end
+ :info info
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-babel-call-interpreter (babel-call contents)
"Interpret BABEL-CALL element as Org syntax.
@@ -1340,13 +1553,13 @@ as keywords."
(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))
+ (skip-chars-forward " \t")
+ (org-element-timestamp-parser)))
+ (duration (and (search-forward " => " (line-end-position) t)
+ (progn (skip-chars-forward " \t")
+ (looking-at "\\(\\S-+\\)[ \t]*$"))
+ (org-match-string-no-properties 1)))
+ (status (if duration 'closed 'running))
(post-blank (let ((before-blank (progn (forward-line) (point))))
(skip-chars-forward " \r\t\n" limit)
(skip-chars-backward " \t")
@@ -1356,7 +1569,7 @@ as keywords."
(list 'clock
(list :status status
:value value
- :time time
+ :duration duration
:begin begin
:end end
:post-blank post-blank)))))
@@ -1365,30 +1578,34 @@ as keywords."
"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
+ (org-element-timestamp-interpreter
+ (org-element-property :value clock) nil)
+ (let ((duration (org-element-property :duration clock)))
+ (and duration
(concat " => "
(apply 'format
"%2s:%02s"
- (org-split-string time ":")))))))
+ (org-split-string duration ":")))))))
;;;; Comment
-(defun org-element-comment-parser (limit)
+(defun org-element-comment-parser (limit affiliated)
"Parse a comment.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `comment' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank'
-keywords.
+containing `:begin', `:end', `:value', `:post-blank',
+`:post-affiliated' keywords.
Assume point is at comment beginning."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(value (prog2 (looking-at "[ \t]*# ?")
(buffer-substring-no-properties
(match-end 0) (line-end-position))
@@ -1408,15 +1625,15 @@ Assume point is at comment beginning."
(point)))
(end (progn (goto-char com-end)
(skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'comment
(nconc
(list :begin begin
:end end
:value value
- :post-blank (count-lines com-end end))
- (cadr keywords))))))
+ :post-blank (count-lines com-end end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-comment-interpreter (comment contents)
"Interpret COMMENT element as Org syntax.
@@ -1426,33 +1643,35 @@ CONTENTS is nil."
;;;; Comment Block
-(defun org-element-comment-block-parser (limit)
+(defun org-element-comment-block-parser (limit affiliated)
"Parse an export block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `comment-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:value' and
-`:post-blank' keywords.
+containing `:begin', `:end', `:hiddenp', `:value', `:post-blank'
+and `:post-affiliated' keywords.
Assume point is at comment block beginning."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(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)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))
+ (if (eobp) (point) (line-beginning-position))))
(value (buffer-substring-no-properties
contents-begin contents-end)))
(list 'comment-block
@@ -1461,8 +1680,9 @@ Assume point is at comment block beginning."
:end end
:value value
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-comment-block-interpreter (comment-block contents)
"Interpret COMMENT-BLOCK element as Org syntax.
@@ -1471,32 +1691,105 @@ CONTENTS is nil."
(org-remove-indentation (org-element-property :value comment-block))))
+;;;; Diary Sexp
+
+(defun org-element-diary-sexp-parser (limit affiliated)
+ "Parse a diary sexp.
+
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
+
+Return a list whose CAR is `diary-sexp' and CDR is a plist
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords."
+ (save-excursion
+ (let ((begin (car affiliated))
+ (post-affiliated (point))
+ (value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
+ (org-match-string-no-properties 1)))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'diary-sexp
+ (nconc
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
+
+(defun org-element-diary-sexp-interpreter (diary-sexp contents)
+ "Interpret DIARY-SEXP as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value diary-sexp))
+
+
;;;; Example Block
-(defun org-element-example-block-parser (limit)
+(defun org-element--remove-indentation (s &optional n)
+ "Remove maximum common indentation in string S and return it.
+When optional argument N is a positive integer, remove exactly
+that much characters from indentation, if possible, or return
+S as-is otherwise. Unlike to `org-remove-indentation', this
+function doesn't call `untabify' on S."
+ (catch 'exit
+ (with-temp-buffer
+ (insert s)
+ (goto-char (point-min))
+ ;; Find maximum common indentation, if not specified.
+ (setq n (or n
+ (let ((min-ind (point-max)))
+ (save-excursion
+ (while (re-search-forward "^[ \t]*\\S-" nil t)
+ (let ((ind (1- (current-column))))
+ (if (zerop ind) (throw 'exit s)
+ (setq min-ind (min min-ind ind))))))
+ min-ind)))
+ (if (zerop n) s
+ ;; Remove exactly N indentation, but give up if not possible.
+ (while (not (eobp))
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (cond ((eolp) (delete-region (line-beginning-position) (point)))
+ ((< ind n) (throw 'exit s))
+ (t (org-indent-line-to (- ind n))))
+ (forward-line)))
+ (buffer-string)))))
+
+(defun org-element-example-block-parser (limit affiliated)
"Parse an example block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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."
+`:switches', `:value', `:post-blank' and `:post-affiliated'
+keywords."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
(let* ((switches
- (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
- (org-match-string-no-properties 1)))
+ (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)))
+ (number-lines
+ (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent
+ (or org-src-preserve-indentation
+ (and switches (string-match "-i\\>" switches))))
;; Should labels be retained in (or stripped from) example
;; blocks?
(retain-labels
@@ -1507,24 +1800,28 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
;; 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)))
+ (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))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ (block-ind (progn (skip-chars-forward " \t") (current-column)))
(contents-begin (progn (forward-line) (point)))
(hidden (org-invisible-p2))
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties
- contents-begin contents-end)))
+ (value (org-element--remove-indentation
+ (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ contents-begin contents-end))
+ (and preserve-indent block-ind)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'example-block
(nconc
(list :begin begin
@@ -1537,30 +1834,33 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
:use-labels use-labels
:label-fmt label-fmt
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(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-escape-code-in-string
- (org-element-property :value example-block)))
+ (org-escape-code-in-string
+ (org-element-property :value example-block))
"#+END_EXAMPLE")))
;;;; Export Block
-(defun org-element-export-block-parser (limit)
+(defun org-element-export-block-parser (limit affiliated)
"Parse an export block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `export-block' and CDR is a plist
-containing `:begin', `:end', `:type', `:hiddenp', `:value' and
-`:post-blank' keywords.
+containing `:begin', `:end', `:type', `:hiddenp', `:value',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at export-block beginning."
(let* ((case-fold-search t)
@@ -1570,19 +1870,18 @@ Assume point is at export-block beginning."
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(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)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))
+ (if (eobp) (point) (line-beginning-position))))
(value (buffer-substring-no-properties contents-begin
contents-end)))
(list 'export-block
@@ -1592,8 +1891,9 @@ Assume point is at export-block beginning."
:type type
:value value
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-export-block-interpreter (export-block contents)
"Interpret EXPORT-BLOCK element as Org syntax.
@@ -1606,18 +1906,22 @@ CONTENTS is nil."
;;;; Fixed-width
-(defun org-element-fixed-width-parser (limit)
+(defun org-element-fixed-width-parser (limit affiliated)
"Parse a fixed-width section.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `fixed-width' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank' keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the fixed-width area."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
value
(end-area
(progn
@@ -1632,45 +1936,52 @@ Assume point is at the beginning of the fixed-width area."
(forward-line))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'fixed-width
(nconc
(list :begin begin
:end end
:value value
- :post-blank (count-lines end-area end))
- (cadr keywords))))))
+ :post-blank (count-lines end-area end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(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)))
+ (let ((value (org-element-property :value fixed-width)))
+ (and value
+ (replace-regexp-in-string
+ "^" ": "
+ (if (string-match "\n\\'" value) (substring value 0 -1) value)))))
;;;; Horizontal Rule
-(defun org-element-horizontal-rule-parser (limit)
+(defun org-element-horizontal-rule-parser (limit affiliated)
"Parse an horizontal rule.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `horizontal-rule' and CDR is a plist
-containing `:begin', `:end' and `:post-blank' keywords."
+containing `:begin', `:end', `:post-blank' and `:post-affiliated'
+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)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (let ((begin (car affiliated))
+ (post-affiliated (point))
+ (post-hr (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
(list 'horizontal-rule
(nconc
(list :begin begin
:end end
- :post-blank (count-lines post-hr end))
- (cadr keywords))))))
+ :post-blank (count-lines post-hr end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
"Interpret HORIZONTAL-RULE element as Org syntax.
@@ -1680,31 +1991,36 @@ CONTENTS is nil."
;;;; Keyword
-(defun org-element-keyword-parser (limit)
+(defun org-element-keyword-parser (limit affiliated)
"Parse a keyword at point.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `keyword' and CDR is a plist
-containing `:key', `:value', `:begin', `:end' and `:post-blank'
-keywords."
+containing `:key', `:value', `:begin', `:end', `:post-blank' and
+`:post-affiliated' 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)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (let ((begin (car affiliated))
+ (post-affiliated (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) (line-beginning-position)))))
(list 'keyword
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end))))))
+ (nconc
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-keyword-interpreter (keyword contents)
"Interpret KEYWORD element as Org syntax.
@@ -1716,39 +2032,41 @@ CONTENTS is nil."
;;;; Latex Environment
-(defun org-element-latex-environment-parser (limit)
+(defun org-element-latex-environment-parser (limit affiliated)
"Parse a LaTeX environment.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `latex-environment' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank'
-keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' 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}[ \t]*$" env) limit t)
- (forward-line)
- (point)))
- (value (buffer-substring-no-properties code-begin code-end))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
- (list 'latex-environment
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines code-end end))
- (cadr keywords))))))
+ (let ((case-fold-search t)
+ (code-begin (point)))
+ (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
+ (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$"
+ (regexp-quote (match-string 1)))
+ limit t))
+ ;; Incomplete latex environment: parse it as a paragraph.
+ (org-element-paragraph-parser limit affiliated)
+ (let* ((code-end (progn (forward-line) (point)))
+ (begin (car affiliated))
+ (value (buffer-substring-no-properties code-begin code-end))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'latex-environment
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines code-end end)
+ :post-affiliated code-begin)
+ (cdr affiliated))))))))
(defun org-element-latex-environment-interpreter (latex-environment contents)
"Interpret LATEX-ENVIRONMENT element as Org syntax.
@@ -1756,28 +2074,58 @@ CONTENTS is nil."
(org-element-property :value latex-environment))
+;;;; Node Property
+
+(defun org-element-node-property-parser (limit)
+ "Parse a node-property at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `node-property' and CDR is a plist
+containing `:key', `:value', `:begin', `:end' and `:post-blank'
+keywords."
+ (save-excursion
+ (looking-at org-property-re)
+ (let ((case-fold-search t)
+ (begin (point))
+ (key (org-match-string-no-properties 2))
+ (value (org-match-string-no-properties 3))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (point-at-bol)))))
+ (list 'node-property
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end))))))
+
+(defun org-element-node-property-interpreter (node-property contents)
+ "Interpret NODE-PROPERTY element as Org syntax.
+CONTENTS is nil."
+ (format org-property-format
+ (format ":%s:" (org-element-property :key node-property))
+ (org-element-property :value node-property)))
+
+
;;;; Paragraph
-(defun org-element-paragraph-parser (limit)
+(defun org-element-paragraph-parser (limit affiliated)
"Parse a paragraph.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `paragraph' and CDR is a plist
containing `:begin', `:end', `:contents-begin' and
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the paragraph."
(save-excursion
- (let* ((contents-begin (point))
- ;; 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)))
- (keywords (unless inner-par-p
- (org-element--collect-affiliated-keywords)))
- (begin (if inner-par-p contents-begin (car keywords)))
+ (let* ((begin (car affiliated))
+ (contents-begin (point))
(before-blank
(let ((case-fold-search t))
(end-of-line)
@@ -1811,20 +2159,21 @@ Assume point is at the beginning of the paragraph."
(re-search-forward
"^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Stop at valid blocks.
- (and (looking-at
- "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(save-excursion
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid latex environments.
(and (looking-at
- "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}[ \t]*$")
+ "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
(save-excursion
(re-search-forward
(format "^[ \t]*\\\\end{%s}[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid keywords.
(looking-at "[ \t]*#\\+\\S-+:")
@@ -1841,16 +2190,16 @@ Assume point is at the beginning of the paragraph."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(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))))))
+ :post-blank (count-lines before-blank end)
+ :post-affiliated contents-begin)
+ (cdr affiliated))))))
(defun org-element-paragraph-interpreter (paragraph contents)
"Interpret PARAGRAPH element as Org syntax.
@@ -1879,13 +2228,11 @@ and `:post-blank' keywords."
(end (point))
closed deadline scheduled)
(goto-char begin)
- (while (re-search-forward org-keyword-time-not-clock-regexp
- (line-end-position) t)
+ (while (re-search-forward org-keyword-time-not-clock-regexp end 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)))
+ (skip-chars-forward " \t" end)
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
(cond ((equal keyword org-closed-string) (setq closed time))
((equal keyword org-deadline-string) (setq deadline time))
(t (setq scheduled time)))))
@@ -1903,69 +2250,21 @@ 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 ">")))
+ (list (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat org-deadline-string " "
+ (org-element-timestamp-interpreter deadline nil))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
- (concat org-scheduled-string " <" scheduled ">")))))
+ (concat org-scheduled-string " "
+ (org-element-timestamp-interpreter scheduled nil))))
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat org-closed-string " "
+ (org-element-timestamp-interpreter closed nil))))))
" "))
-;;;; 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:[ \t]*$"))
- (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)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
- (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)
@@ -1999,28 +2298,30 @@ CONTENTS is nil."
;;;; Src Block
-(defun org-element-src-block-parser (limit)
+(defun org-element-src-block-parser (limit affiliated)
"Parse a src block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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.
+`:use-labels', `:label-fmt', `:preserve-indent', `:value',
+`:post-blank' and `:post-affiliated' 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[ \t]*$"
limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- ;; Get beginning position.
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Get language as a string.
(language
(progn
@@ -2035,13 +2336,17 @@ Assume point is at the beginning of the block."
;; 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)))
+ (number-lines
+ (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent (or org-src-preserve-indentation
+ (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
@@ -2052,19 +2357,24 @@ Assume point is at the beginning of the block."
;; line-numbers?
(use-labels
(or (not switches)
- (and retain-labels (not (string-match "-k\\>" switches)))))
+ (and retain-labels
+ (not (string-match "-k\\>" switches)))))
+ ;; Indentation.
+ (block-ind (progn (skip-chars-forward " \t") (current-column)))
;; Get visibility status.
(hidden (progn (forward-line) (org-invisible-p2)))
;; Retrieve code.
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties (point) contents-end)))
+ (value (org-element--remove-indentation
+ (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ (point) contents-end))
+ (and preserve-indent block-ind)))
(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)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'src-block
(nconc
(list :language language
@@ -2081,8 +2391,9 @@ Assume point is at the beginning of the block."
:label-fmt label-fmt
:hiddenp hidden
:value value
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-src-block-interpreter (src-block contents)
"Interpret SRC-BLOCK element as Org syntax.
@@ -2092,15 +2403,13 @@ CONTENTS is nil."
(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))
+ ((org-element-property :preserve-indent src-block) val)
+ ((zerop org-edit-src-content-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)))))))
+ "\\(^\\)[ \t]*\\S-" ind val nil nil 1)))))))
(concat (format "#+BEGIN_SRC%s\n"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
@@ -2111,22 +2420,25 @@ CONTENTS is nil."
;;;; Table
-(defun org-element-table-parser (limit)
+(defun org-element-table-parser (limit affiliated)
"Parse a table at point.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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.
+`:contents-end', `:value', `:post-blank' and `:post-affiliated'
+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))
+ (begin (car affiliated))
(table-end
(if (re-search-forward org-table-any-border-regexp limit 'm)
(goto-char (match-beginning 0))
@@ -2138,8 +2450,7 @@ Assume point is at the beginning of the table."
acc))
(pos-before-blank (point))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'table
(nconc
(list :begin begin
@@ -2154,8 +2465,9 @@ Assume point is at the beginning of the table."
:value (and (eq type 'table.el)
(buffer-substring-no-properties
table-begin table-end))
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated table-begin)
+ (cdr affiliated))))))
(defun org-element-table-interpreter (table contents)
"Interpret TABLE element as Org syntax.
@@ -2211,33 +2523,35 @@ CONTENTS is the contents of the table row."
;;;; Verse Block
-(defun org-element-verse-block-parser (limit)
+(defun org-element-verse-block-parser (limit affiliated)
"Parse a verse block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
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.
+`:hiddenp', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of the block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(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)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'verse-block
(nconc
(list :begin begin
@@ -2245,8 +2559,9 @@ Assume point is at beginning of the block."
:contents-begin contents-begin
:contents-end contents-end
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-verse-block-interpreter (verse-block contents)
"Interpret VERSE-BLOCK element as Org syntax.
@@ -2312,17 +2627,15 @@ Assume point is at the first star marker."
CONTENTS is the contents of the object."
(format "*%s*" contents))
-(defun org-element-text-markup-successor (limit)
+(defun org-element-text-markup-successor ()
"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)
+ (when (re-search-forward org-emph-re nil t)
(let ((marker (match-string 3)))
(cons (cond
((equal marker "*") 'bold)
@@ -2404,25 +2717,19 @@ CONTENTS is nil."
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
-(defun org-element-latex-or-entity-successor (limit)
+(defun org-element-latex-or-entity-successor ()
"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
(unless (bolp) (backward-char))
- (let ((matchers
- (remove "begin" (plist-get org-format-latex-options :matchers)))
+ (let ((matchers (cdr org-latex-regexps))
;; 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)
+ (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t)
(goto-char (match-beginning 0))
(if (looking-at entity-re)
;; Determine if it's a real entity or a LaTeX command.
@@ -2432,12 +2739,9 @@ Return value is a cons cell whose CAR is `entity' or
;; 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)
+ (dolist (e matchers)
+ (when (looking-at (nth 1 e))
+ (throw 'return (match-beginning (nth 2 e)))))
(point))))))))
@@ -2474,18 +2778,16 @@ CONTENTS is nil."
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
-(defun org-element-export-snippet-successor (limit)
+(defun org-element-export-snippet-successor ()
"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)
+ (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t)
(setq beg (match-beginning 0))
- (search-forward "@@" limit t))
+ (search-forward "@@" nil t))
(cons 'export-snippet beg)))))
@@ -2541,21 +2843,19 @@ CONTENTS is nil."
(concat ":" (org-element-interpret-data inline-def))))))
(format "[%s]" (concat label def))))
-(defun org-element-footnote-reference-successor (limit)
+(defun org-element-footnote-reference-successor ()
"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)
+ (while (re-search-forward org-footnote-re nil t)
(save-excursion
(let ((beg (match-beginning 0))
(count 1))
(backward-char)
- (while (re-search-forward "[][]" limit t)
+ (while (re-search-forward "[][]" nil t)
(if (equal (match-string 0) "[") (incf count) (decf count))
(when (zerop count)
(throw 'exit (cons 'footnote-reference beg))))))))))
@@ -2598,11 +2898,9 @@ CONTENTS is nil."
main-source)
(and post-options (format "[%s]" post-options)))))
-(defun org-element-inline-babel-call-successor (limit)
+(defun org-element-inline-babel-call-successor ()
"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
@@ -2610,7 +2908,7 @@ CDR is beginning position."
;; `org-babel-inline-lob-one-liner-regexp'.
(when (re-search-forward
"call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?"
- limit t)
+ nil t)
(cons 'inline-babel-call (match-beginning 0)))))
@@ -2619,8 +2917,6 @@ CDR is beginning position."
(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.
@@ -2655,16 +2951,14 @@ CONTENTS is nil."
(if arguments (format "[%s]" arguments) "")
body)))
-(defun org-element-inline-src-block-successor (limit)
+(defun org-element-inline-src-block-successor ()
"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)
+ (when (re-search-forward org-babel-inline-src-block-regexp nil t)
(cons 'inline-src-block (match-beginning 1)))))
;;;; Italic
@@ -2702,29 +2996,28 @@ CONTENTS is the contents of the object."
;;;; Latex Fragment
(defun org-element-latex-fragment-parser ()
- "Parse latex fragment at point.
+ "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."
+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))
+ (dolist (e (cdr org-latex-regexps))
+ (let ((latex-regexp (nth 1 e)))
+ (when (or (looking-at latex-regexp)
+ (and (not (bobp))
+ (save-excursion
+ (backward-char)
+ (looking-at latex-regexp))))
+ (throw 'exit (nth 2 e)))))
;; None found: it's a macro.
(looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
0))
- (value (match-string-no-properties substring-match))
+ (value (org-match-string-no-properties substring-match))
(post-blank (progn (goto-char (match-end substring-match))
(skip-chars-forward " \t")))
(end (point)))
@@ -2748,22 +3041,23 @@ 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)))
+ (list 'line-break
+ (list :begin (point)
+ :end (progn (forward-line) (point))
+ :post-blank 0)))
(defun org-element-line-break-interpreter (line-break contents)
"Interpret LINE-BREAK object as Org syntax.
CONTENTS is nil."
- "\\\\")
+ "\\\\\n")
-(defun org-element-line-break-successor (limit)
+(defun org-element-line-break-successor ()
"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)
+ (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil 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))
@@ -2776,14 +3070,15 @@ beginning position."
"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.
+`:path', `:raw-link', `:application', `:search-option', `: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)
+ raw-link link search-option application)
(cond
;; Type 1: Text targeted from a radio target.
((and org-target-link-regexp (looking-at org-target-link-regexp))
@@ -2795,53 +3090,70 @@ Assume point is at the beginning of the link."
(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))))
+ ;; RAW-LINK is the original link. Expand any
+ ;; abbreviation in it.
+ raw-link (org-translate-link
+ (org-link-expand-abbrev
+ (org-match-string-no-properties 1))))
;; 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))
+ ((or (file-name-absolute-p raw-link)
+ (string-match "^\\.\\.?/" raw-link))
+ (setq type "file" path raw-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)))
+ ((string-match org-link-re-with-space3 raw-link)
+ (setq type (match-string 1 raw-link) path (match-string 2 raw-link)))
;; Id type: PATH is the id.
- ((string-match "^id:\\([-a-f0-9]+\\)" link)
- (setq type "id" path (match-string 1 link)))
+ ((string-match "^id:\\([-a-f0-9]+\\)" raw-link)
+ (setq type "id" path (match-string 1 raw-link)))
;; Code-ref type: PATH is the name of the reference.
- ((string-match "^(\\(.*\\))$" link)
- (setq type "coderef" path (match-string 1 link)))
+ ((string-match "^(\\(.*\\))$" raw-link)
+ (setq type "coderef" path (match-string 1 raw-link)))
;; Custom-id type: PATH is the name of the custom id.
- ((= (aref link 0) ?#)
- (setq type "custom-id" path (substring link 1)))
+ ((= (aref raw-link 0) ?#)
+ (setq type "custom-id" path (substring raw-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))))
+ (t (setq type "fuzzy" path raw-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)))
+ link-end (match-end 0)
+ path (org-match-string-no-properties 2)))
;; 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))))
+ link-end (match-end 0)
+ path (org-match-string-no-properties 2))))
;; 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))
+ ;; Extract search option and opening application out of
+ ;; "file"-type links.
+ (when (member type org-element-link-type-is-file)
+ ;; Application.
+ (cond ((string-match "^file\\+\\(.*\\)$" type)
+ (setq application (match-string 1 type)))
+ ((not (string-match "^file" type))
+ (setq application type)))
+ ;; Extract search option from PATH.
+ (when (string-match "::\\(.*\\)$" path)
+ (setq search-option (match-string 1 path)
+ path (replace-match "" nil nil path)))
+ ;; Make sure TYPE always reports "file".
+ (setq type "file"))
(list 'link
(list :type type
:path path
:raw-link (or raw-link path)
+ :application application
+ :search-option search-option
:begin begin
:end end
:contents-begin contents-begin
@@ -2858,20 +3170,26 @@ CONTENTS is the contents of the object, or nil."
raw-link
(if contents (format "[%s]" contents) "")))))
-(defun org-element-link-successor (limit)
+(defun org-element-link-successor ()
"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)
+ (when (re-search-forward link-regexp nil t)
(cons 'link (match-beginning 0))))))
+(defun org-element-plain-link-successor ()
+ "Search for the next plain link object.
+
+Return value is a cons cell whose CAR is `link' and CDR is
+beginning position."
+ (and (save-excursion (re-search-forward org-plain-link-re nil t))
+ (cons 'link (match-beginning 0))))
+
;;;; Macro
@@ -2891,20 +3209,19 @@ Assume point is at the macro."
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point))
- (args (let ((args (org-match-string-no-properties 3)) args2)
+ (args (let ((args (org-match-string-no-properties 3)))
(when args
;; Do not use `org-split-string' since empty
;; strings are meaningful here.
- (setq args (split-string args ","))
- (while args
- (while (string-match "\\\\\\'" (car args))
- ;; Repair bad splits, when comma is protected,
- ;; and thus not a real separator.
- (setcar (cdr args) (concat (substring (car args) 0 -1)
- "," (nth 1 args)))
- (pop args))
- (push (pop args) args2))
- (mapcar 'org-trim (nreverse args2))))))
+ (split-string
+ (replace-regexp-in-string
+ "\\(\\\\*\\)\\(,\\)"
+ (lambda (str)
+ (let ((len (length (match-string 1 str))))
+ (concat (make-string (/ len 2) ?\\)
+ (if (zerop (mod len 2)) "\000" ","))))
+ args nil t)
+ "\000")))))
(list 'macro
(list :key key
:value value
@@ -2918,17 +3235,15 @@ Assume point is at the macro."
CONTENTS is nil."
(org-element-property :value macro))
-(defun org-element-macro-successor (limit)
+(defun org-element-macro-successor ()
"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)
+ nil t)
(cons 'macro (match-beginning 0)))))
@@ -2964,15 +3279,13 @@ Assume point is at the radio target."
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
-(defun org-element-radio-target-successor (limit)
+(defun org-element-radio-target-successor ()
"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)
+ (when (re-search-forward org-radio-target-regexp nil t)
(cons 'radio-target (match-beginning 0)))))
@@ -3004,15 +3317,13 @@ Assume point is at the beginning of the statistics-cookie."
CONTENTS is nil."
(org-element-property :value statistics-cookie))
-(defun org-element-statistics-cookie-successor (limit)
+(defun org-element-statistics-cookie-successor ()
"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)
+ (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t)
(cons 'statistics-cookie (match-beginning 0)))))
@@ -3085,16 +3396,14 @@ CONTENTS is the contents of the object."
(if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
contents))
-(defun org-element-sub/superscript-successor (limit)
+(defun org-element-sub/superscript-successor ()
"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
(unless (bolp) (backward-char))
- (when (re-search-forward org-match-substring-regexp limit t)
+ (when (re-search-forward org-match-substring-regexp nil t)
(cons (if (string= (match-string 2) "_") 'subscript 'superscript)
(match-beginning 2)))))
@@ -3161,14 +3470,12 @@ and `:post-blank' keywords."
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
-(defun org-element-table-cell-successor (limit)
+(defun org-element-table-cell-successor ()
"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))))
+ (when (looking-at "[ \t]*.*?[ \t]*|") (cons 'table-cell (point))))
;;;; Target
@@ -3198,15 +3505,13 @@ Assume point is at the target."
CONTENTS is nil."
(format "<<%s>>" (org-element-property :value target)))
-(defun org-element-target-successor (limit)
+(defun org-element-target-successor ()
"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)
+ (when (re-search-forward org-target-regexp nil t)
(cons 'target (match-beginning 0)))))
@@ -3216,51 +3521,202 @@ beginning position."
"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.
+`:type', `:raw-value', `:year-start', `:month-start',
+`:day-start', `:hour-start', `:minute-start', `:year-end',
+`:month-end', `:day-end', `:hour-end', `:minute-end',
+`:repeater-type', `:repeater-value', `:repeater-unit',
+`:warning-type', `:warning-value', `:warning-unit', `: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
+ (raw-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)))
+ (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
+ (match-string-no-properties 0)))
+ (date-start (match-string-no-properties 1))
+ (date-end (match-string 3))
+ (diaryp (match-beginning 2))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
- (end (point)))
+ (end (point))
+ (time-range
+ (and (not diaryp)
+ (string-match
+ "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
+ date-start)
+ (cons (string-to-number (match-string 2 date-start))
+ (string-to-number (match-string 3 date-start)))))
+ (type (cond (diaryp 'diary)
+ ((and activep (or date-end time-range)) 'active-range)
+ (activep 'active)
+ ((or date-end time-range) 'inactive-range)
+ (t 'inactive)))
+ (repeater-props
+ (and (not diaryp)
+ (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
+ raw-value)
+ (list
+ :repeater-type
+ (let ((type (match-string 1 raw-value)))
+ (cond ((equal "++" type) 'catch-up)
+ ((equal ".+" type) 'restart)
+ (t 'cumulate)))
+ :repeater-value (string-to-number (match-string 2 raw-value))
+ :repeater-unit
+ (case (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ (warning-props
+ (and (not diaryp)
+ (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
+ (list
+ :warning-type (if (match-string 1 raw-value) 'first 'all)
+ :warning-value (string-to-number (match-string 2 raw-value))
+ :warning-unit
+ (case (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ year-start month-start day-start hour-start minute-start year-end
+ month-end day-end hour-end minute-end)
+ ;; Parse date-start.
+ (unless diaryp
+ (let ((date (org-parse-time-string date-start t)))
+ (setq year-start (nth 5 date)
+ month-start (nth 4 date)
+ day-start (nth 3 date)
+ hour-start (nth 2 date)
+ minute-start (nth 1 date))))
+ ;; Compute date-end. It can be provided directly in time-stamp,
+ ;; or extracted from time range. Otherwise, it defaults to the
+ ;; same values as date-start.
+ (unless diaryp
+ (let ((date (and date-end (org-parse-time-string date-end t))))
+ (setq year-end (or (nth 5 date) year-start)
+ month-end (or (nth 4 date) month-start)
+ day-end (or (nth 3 date) day-start)
+ hour-end (or (nth 2 date) (car time-range) hour-start)
+ minute-end (or (nth 1 date) (cdr time-range) minute-start))))
(list 'timestamp
- (list :type type
- :value main-value
- :range-end range-end
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (nconc (list :type type
+ :raw-value raw-value
+ :year-start year-start
+ :month-start month-start
+ :day-start day-start
+ :hour-start hour-start
+ :minute-start minute-start
+ :year-end year-end
+ :month-end month-end
+ :day-end day-end
+ :hour-end hour-end
+ :minute-end minute-end
+ :begin begin
+ :end end
+ :post-blank post-blank)
+ repeater-props
+ warning-props)))))
(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)
+ ;; Use `:raw-value' if specified.
+ (or (org-element-property :raw-value timestamp)
+ ;; Otherwise, build timestamp string.
+ (let* ((repeat-string
+ (concat
+ (case (org-element-property :repeater-type timestamp)
+ (cumulate "+") (catch-up "++") (restart ".+"))
+ (let ((val (org-element-property :repeater-value timestamp)))
+ (and val (number-to-string val)))
+ (case (org-element-property :repeater-unit timestamp)
+ (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (warning-string
+ (concat
+ (case (org-element-property :warning-type timestamp)
+ (first "--")
+ (all "-"))
+ (let ((val (org-element-property :warning-value timestamp)))
+ (and val (number-to-string val)))
+ (case (org-element-property :warning-unit timestamp)
+ (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (build-ts-string
+ ;; Build an Org timestamp string from TIME. ACTIVEP is
+ ;; non-nil when time stamp is active. If WITH-TIME-P is
+ ;; non-nil, add a time part. HOUR-END and MINUTE-END
+ ;; specify a time range in the timestamp. REPEAT-STRING
+ ;; is the repeater string, if any.
+ (lambda (time activep &optional with-time-p hour-end minute-end)
+ (let ((ts (format-time-string
+ (funcall (if with-time-p 'cdr 'car)
+ org-time-stamp-formats)
+ time)))
+ (when (and hour-end minute-end)
+ (string-match "[012]?[0-9]:[0-5][0-9]" ts)
+ (setq ts
+ (replace-match
+ (format "\\&-%02d:%02d" hour-end minute-end)
+ nil nil ts)))
+ (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
+ (dolist (s (list repeat-string warning-string))
+ (when (org-string-nw-p s)
+ (setq ts (concat (substring ts 0 -1)
+ " "
+ s
+ (substring ts -1)))))
+ ;; Return value.
+ ts)))
+ (type (org-element-property :type timestamp)))
+ (case type
+ ((active inactive)
+ (let* ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp))
+ (time-range-p (and hour-start hour-end minute-start minute-end
+ (or (/= hour-start hour-end)
+ (/= minute-start minute-end)))))
+ (funcall
+ build-ts-string
+ (encode-time 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active)
+ (and hour-start minute-start)
+ (and time-range-p hour-end)
+ (and time-range-p minute-end))))
+ ((active-range inactive-range)
+ (let ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp)))
+ (concat
+ (funcall
+ build-ts-string (encode-time
+ 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active-range)
+ (and hour-start minute-start))
+ "--"
+ (funcall build-ts-string
+ (encode-time 0
+ (or minute-end 0)
+ (or hour-end 0)
+ (org-element-property :day-end timestamp)
+ (org-element-property :month-end timestamp)
+ (org-element-property :year-end timestamp))
+ (eq type 'active-range)
+ (and hour-end minute-end)))))))))
+
+(defun org-element-timestamp-successor ()
"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
@@ -3270,7 +3726,7 @@ beginning position."
"\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|"
"\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
- limit t)
+ nil t)
(cons 'timestamp (match-beginning 0)))))
@@ -3345,21 +3801,21 @@ CONTENTS is nil."
;; `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'.
+;; `section'). Special modes are: `first-section', `item',
+;; `node-property', `quote-section', `section' 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'.
+LIMIT bounds the search.
+
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
@@ -3367,8 +3823,8 @@ 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'.
+`first-section', `item', `node-property', `quote-section',
+`section', and `table-row'.
If STRUCTURE isn't provided but SPECIAL is set to `item', it will
be computed.
@@ -3376,13 +3832,6 @@ 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
@@ -3394,6 +3843,8 @@ element it has to parse."
(org-element-item-parser limit structure raw-secondary-p))
;; Table Row.
((eq special 'table-row) (org-element-table-row-parser limit))
+ ;; Node Property.
+ ((eq special 'node-property) (org-element-node-property-parser limit))
;; Headline.
((org-with-limited-levels (org-at-heading-p))
(org-element-headline-parser limit raw-secondary-p))
@@ -3406,180 +3857,146 @@ element it has to parse."
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))
+ ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
;; Planning and Clock.
- ((and (looking-at org-planning-or-clock-line-re))
+ ((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))))))
+ ;; From there, elements can have affiliated keywords.
+ (t (let ((affiliated (org-element--collect-affiliated-keywords limit)))
+ (cond
+ ;; Jumping over affiliated keywords put point off-limits.
+ ;; Parse them as regular keywords.
+ ((and (cdr affiliated) (>= (point) limit))
+ (goto-char (car affiliated))
+ (org-element-keyword-parser limit nil))
+ ;; LaTeX Environment.
+ ((looking-at
+ "[ \t]*\\\\begin{[A-Za-z0-9*]+}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$")
+ (org-element-latex-environment-parser limit affiliated))
+ ;; Drawer and Property Drawer.
+ ((looking-at org-drawer-regexp)
+ (if (equal (match-string 1) "PROPERTIES")
+ (org-element-property-drawer-parser limit affiliated)
+ (org-element-drawer-parser limit affiliated)))
+ ;; Fixed Width
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (org-element-fixed-width-parser limit affiliated))
+ ;; 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 affiliated))
+ ((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 affiliated)
+ (org-element-special-block-parser limit affiliated))))
+ ((looking-at "\\+CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit affiliated))
+ ((looking-at "\\+BEGIN:? ")
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit affiliated))
+ ((looking-at "\\+\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit affiliated))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit affiliated))))
+ ;; Footnote Definition.
+ ((looking-at org-footnote-definition-re)
+ (org-element-footnote-definition-parser limit affiliated))
+ ;; Horizontal Rule.
+ ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
+ (org-element-horizontal-rule-parser limit affiliated))
+ ;; Diary Sexp.
+ ((looking-at "%%(")
+ (org-element-diary-sexp-parser limit affiliated))
+ ;; Table.
+ ((org-at-table-p t) (org-element-table-parser limit affiliated))
+ ;; List.
+ ((looking-at (org-item-re))
+ (org-element-plain-list-parser
+ limit affiliated
+ (or structure (org-element--list-struct limit))))
+ ;; Default element: Paragraph.
+ (t (org-element-paragraph-parser limit affiliated)))))))))
;; 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'.
+(defun org-element--collect-affiliated-keywords (limit)
+ "Collect affiliated keywords from point down to LIMIT.
Return a list whose CAR is the position at the first of them and
-CDR a plist of keywords and values."
- (save-excursion
+CDR a plist of keywords and values and move point to the
+beginning of the first line after them.
+
+As a special case, if element doesn't start at the beginning of
+the line (i.e. a paragraph starting an item), CAR is current
+position of point and CDR is nil."
+ (if (not (bolp)) (list (point))
(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))
+ (origin (point))
;; 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))))
+ (while (and (< (point) limit) (looking-at org-element--affiliated-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
+ org-element-keyword-translation-alist))
+ raw-kwd))
+ ;; Find main value for any keyword.
+ (value
+ (save-match-data
+ (org-trim
+ (buffer-substring-no-properties
+ (match-end 0) (point-at-eol)))))
+ ;; PARSEDP is non-nil when keyword should have its
+ ;; value parsed.
+ (parsedp (member kwd org-element-parsed-keywords))
+ ;; If KWD is a dual keyword, find its secondary
+ ;; value. Maybe parse it.
+ (dualp (member kwd org-element-dual-keywords))
+ (dual-value
+ (and dualp
+ (let ((sec (org-match-string-no-properties 2)))
+ (if (or (not sec) (not parsedp)) 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 parsedp
+ (setq value (org-element-parse-secondary-string value restrict)))
+ (when dualp
+ (setq value (and (or value dual-value) (cons value dual-value))))
+ (when (or (member kwd org-element-multiple-keywords)
+ ;; Attributes can always appear on multiple lines.
+ (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))
+ ;; Move to next keyword.
+ (forward-line)))
+ ;; If affiliated keywords are orphaned: move back to first one.
+ ;; They will be parsed as a paragraph.
+ (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil))
+ ;; Return value.
+ (cons origin output))))
@@ -3658,19 +4075,30 @@ 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)
+ ;; Copy buffer-local variables listed in
+ ;; `org-element-object-variables' into temporary buffer. This is
+ ;; required since object parsing is dependent on these variables.
+ (let ((pairs (delq nil (mapcar (lambda (var)
+ (when (boundp var)
+ (cons var (symbol-value var))))
+ org-element-object-variables))))
+ (with-temp-buffer
+ (mapc (lambda (pair) (org-set-local (car pair) (cdr pair))) pairs)
+ (insert string)
+ (let ((secondary (org-element--parse-objects
+ (point-min) (point-max) nil restriction)))
+ (when parent
+ (mapc (lambda (obj) (org-element-put-property obj :parent parent))
+ secondary))
+ secondary))))
+
+(defun org-element-map
+ (data types fun &optional info first-match no-recursion with-affiliated)
"Map a function on selected elements or objects.
-DATA is an Org buffer parse tree, as returned by, i.e.,
-`org-element-parse-buffer'. TYPES is a symbol or list of symbols
-of elements or objects types (see `org-element-all-elements' and
+DATA is a parse tree, an element, an object, a string, or a list
+of such constructs. TYPES is a symbol or list of symbols of
+elements or objects types (see `org-element-all-elements' and
`org-element-all-objects' for a complete list of types). FUN is
the function called on the matching element or object. It has to
accept one argument: the element or object itself.
@@ -3687,11 +4115,15 @@ 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.
+When optional argument WITH-AFFILIATED is non-nil, FUN will also
+apply to matching objects within parsed affiliated keywords (see
+`org-element-parsed-keywords').
+
Nil values returned from FUN do not appear in the results.
Examples:
---------
+---------
Assuming TREE is a variable containing an Org buffer parse tree,
the following example will return a flat list of all `src-block'
@@ -3702,22 +4134,26 @@ and `example-block' elements in it:
The following snippet will find the first headline with a level
of 1 and a \"phone\" tag, and will return its beginning position:
- \(org-element-map
- tree 'headline
+ \(org-element-map tree 'headline
\(lambda (hl)
\(and (= (org-element-property :level hl) 1)
\(member \"phone\" (org-element-property :tags hl))
\(org-element-property :begin hl)))
nil t)
-Eventually, this last example will return a flat list of all
-`bold' type objects containing a `latex-snippet' type object:
+The next example will return a flat list of all `plain-list' type
+elements in TREE that are not a sub-list themselves:
+
+ \(org-element-map tree 'plain-list 'identity nil nil 'plain-list)
+
+Eventually, this example will return a flat list of all `bold'
+type objects containing a `latex-snippet' type object, even
+looking into captions:
- \(org-element-map
- tree 'bold
+ \(org-element-map tree 'bold
\(lambda (b)
- \(and (org-element-map b 'latex-snippet 'identity nil t)
- b)))"
+ \(and (org-element-map b 'latex-snippet 'identity nil t) b))
+ nil nil nil t)"
;; 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)))
@@ -3739,6 +4175,12 @@ Eventually, this last example will return a flat list of all
(setq category 'elements)))))
types)
category)))
+ ;; Compute properties for affiliated keywords if necessary.
+ (--affiliated-alist
+ (and with-affiliated
+ (mapcar (lambda (kwd)
+ (cons kwd (intern (concat ":" (downcase kwd)))))
+ org-element-affiliated-keywords)))
--acc
--walk-tree
(--walk-tree
@@ -3751,9 +4193,8 @@ Eventually, this last example will return a flat list of all
((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)))
+ ;; List of elements or objects.
+ ((not --type) (mapc --walk-tree --data))
;; Unconditionally enter parse trees.
((eq --type 'org-data)
(mapc --walk-tree (org-element-contents --data)))
@@ -3768,12 +4209,40 @@ Eventually, this last example will return a flat list of all
(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)
+ (when (and (eq --category 'objects) (not (stringp --data)))
(let ((sec-prop
(assq --type org-element-secondary-value-alist)))
(when sec-prop
(funcall --walk-tree
(org-element-property (cdr sec-prop) --data)))))
+ ;; If --DATA has any affiliated keywords and
+ ;; WITH-AFFILIATED is non-nil, look for objects in
+ ;; them.
+ (when (and with-affiliated
+ (eq --category 'objects)
+ (memq --type org-element-all-elements))
+ (mapc (lambda (kwd-pair)
+ (let ((kwd (car kwd-pair))
+ (value (org-element-property
+ (cdr kwd-pair) --data)))
+ ;; Pay attention to the type of value.
+ ;; Preserve order for multiple keywords.
+ (cond
+ ((not value))
+ ((and (member kwd org-element-multiple-keywords)
+ (member kwd org-element-dual-keywords))
+ (mapc (lambda (line)
+ (funcall --walk-tree (cdr line))
+ (funcall --walk-tree (car line)))
+ (reverse value)))
+ ((member kwd org-element-multiple-keywords)
+ (mapc (lambda (line) (funcall --walk-tree line))
+ (reverse value)))
+ ((member kwd org-element-dual-keywords)
+ (funcall --walk-tree (cdr value))
+ (funcall --walk-tree (car value)))
+ (t (funcall --walk-tree value)))))
+ --affiliated-alist))
;; Determine if a recursion into --DATA is possible.
(cond
;; --TYPE is explicitly removed from recursion.
@@ -3793,6 +4262,7 @@ Eventually, this last example will return a flat list of all
(funcall --walk-tree data)
;; Return value in a proper order.
(nreverse --acc))))
+(put 'org-element-map 'lisp-indent-function 2)
;; The following functions are internal parts of the parser.
;;
@@ -3831,6 +4301,10 @@ elements.
Elements are accumulated into ACC."
(save-excursion
(goto-char beg)
+ ;; Visible only: skip invisible parts at the beginning of the
+ ;; element.
+ (when (and visible-only (org-invisible-p2))
+ (goto-char (min (1+ (org-find-visible)) end)))
;; 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)))
@@ -3843,15 +4317,16 @@ Elements are accumulated into ACC."
(type (org-element-type element))
(cbeg (org-element-property :contents-begin element)))
(goto-char (org-element-property :end element))
+ ;; Visible only: skip invisible parts between siblings.
+ (when (and visible-only (org-invisible-p2))
+ (goto-char (min (1+ (org-find-visible)) end)))
;; 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)))
+ ;; If element has no contents, don't modify it.
+ ((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
+ ;; recursion, or ELEMENT is a 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))
@@ -3866,6 +4341,7 @@ Elements are accumulated into ACC."
(if (org-element-property :quotedp element) 'quote-section
'section))
(plain-list 'item)
+ (property-drawer 'node-property)
(table 'table-row))
(and (memq type '(item plain-list))
(org-element-property :structure element))
@@ -3885,98 +4361,87 @@ Elements are accumulated into ACC."
Objects are accumulated in ACC.
-RESTRICTION is a list of object types which are allowed in the
-current object."
- (let (candidates)
+RESTRICTION is a list of object successors which are allowed in
+the current object."
+ (let ((candidates 'initial))
(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))
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (setq candidates
+ (org-element--get-next-object-candidates
+ 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))
(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)
+ cont-beg (org-element-property :contents-end next-object)
+ 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 (eobp)
+ (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 (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."
- ;; Filter out any object found but not belonging to RESTRICTION.
- (setq objects
- (org-remove-if-not
- (lambda (obj)
- (let ((type (car obj)))
- (memq (or (cdr (assq type org-element-object-successor-alist))
- type)
- restriction)))
- objects))
- (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))
+RESTRICTION is a list of object types, as symbols. Only
+candidates with such types are looked after.
+
+OBJECTS is the previous candidates alist. If it is set to
+`initial', no search has been done before, and all symbols in
+RESTRICTION should be looked after.
+
+Return value is an alist whose CAR is the object type and CDR its
+beginning position."
+ (delq
+ nil
+ (if (eq objects 'initial)
+ ;; When searching for the first time, look for every successor
+ ;; allowed in RESTRICTION.
+ (mapcar
+ (lambda (res)
+ (funcall (intern (format "org-element-%s-successor" res))))
+ restriction)
+ ;; Focus on objects returned during last search. Keep those
+ ;; still after point. Search again objects before it.
+ (mapcar
+ (lambda (obj)
+ (if (>= (cdr obj) (point)) obj
+ (let* ((type (car obj))
+ (succ (or (cdr (assq type org-element-object-successor-alist))
+ type)))
+ (and succ
+ (funcall (intern (format "org-element-%s-successor" succ)))))))
+ objects))))
@@ -4014,8 +4479,8 @@ Return Org syntax as a string."
(mapconcat
(lambda (obj) (org-element-interpret-data obj parent))
(org-element-contents data) ""))
- ;; Plain text.
- ((stringp data) data)
+ ;; Plain text: remove `:parent' text property from output.
+ ((stringp data) (org-no-properties data))
;; Element/Object without contents.
((not (org-element-contents data))
(funcall (intern (format "org-element-%s-interpreter" type))
@@ -4083,7 +4548,7 @@ If there is no affiliated keyword, return the empty string."
;; All attribute keywords can have multiple lines.
(string-match "^ATTR_" keyword))
(mapconcat (lambda (line) (funcall keyword-to-org keyword line))
- value
+ (reverse value)
"")
(funcall keyword-to-org keyword value)))))
;; List all ELEMENT's properties matching an attribute line or an
@@ -4242,7 +4707,7 @@ is always the element at point. The 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
+ ;; If at a 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))
@@ -4252,27 +4717,41 @@ first element of current section."
(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
+ (catch 'exit
+ (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-before-first-heading-p)
+ ;; In empty lines at buffer's beginning, return nil.
+ (progn (goto-char (point-min))
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ (throw 'exit nil)))
+ (org-back-to-heading)
+ (forward-line)
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ ;; In blank lines just after the headline, point still
+ ;; belongs to the headline.
+ (throw 'exit
+ (progn (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ (if (not keep-trail)
+ (org-element-headline-parser (point-max) t)
+ (list (org-element-headline-parser
+ (point-max) t))))))))
+ (beginning-of-line)
+ ;; Parse successively each element, skipping those ending
+ ;; before original position.
+ (while t
+ (setq element
(org-element--current-element end 'element special-flag struct)
- type (car element))
+ type (car element))
(org-element-put-property element :parent parent)
(when keep-trail (push element trail))
- (cond
+ (cond
;; 1. Skip any element ending before point. Also skip
;; element ending at point when we're sure that another
;; element has started.
@@ -4299,10 +4778,18 @@ first element of current section."
;; 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))))
+ (or (memq type
+ '(center-block
+ drawer dynamic-block inlinetask
+ property-drawer quote-block
+ special-block))
+ ;; Corner case: if a list ends at the
+ ;; end of a buffer without a final new
+ ;; line, return last element in last
+ ;; item instead.
+ (and (memq type '(item plain-list))
+ (progn (goto-char cend)
+ (or (bolp) (not (eobp))))))))
(throw 'exit (if keep-trail trail element))
(setq parent element)
(case type
@@ -4318,7 +4805,7 @@ first element of current section."
(goto-char cbeg)))))))))))
;;;###autoload
-(defun org-element-context ()
+(defun org-element-context (&optional element)
"Return closest element or object around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
@@ -4328,81 +4815,117 @@ 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'."
- (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-row 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 parent)
- (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))
- (obj-end (org-element-property :end object)))
- (cond
- ;; ORIGIN is after OBJECT, so skip it.
- ((<= obj-end origin)
- (if (/= obj-end end) (goto-char obj-end)
- (throw 'exit
- (org-element-put-property
- object :parent parent))))
- ;; 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
- restriction (org-element-restriction object)
- end cend)))))))
- parent))))))
-
-(defsubst org-element-nested-p (elem-A elem-B)
+`:post-blank'.
+
+Optional argument ELEMENT, when non-nil, is the closest element
+containing point, as returned by `org-element-at-point'.
+Providing it allows for quicker computation."
+ (catch 'objects-forbidden
+ (org-with-wide-buffer
+ (let* ((origin (point))
+ (element (or element (org-element-at-point)))
+ (type (org-element-type element))
+ context)
+ ;; Check if point is inside an element containing objects or at
+ ;; a secondary string. In that case, narrow buffer to the
+ ;; containing area. Otherwise, return ELEMENT.
+ (cond
+ ;; At a parsed affiliated keyword, check if we're inside main
+ ;; or dual value.
+ ((let ((post (org-element-property :post-affiliated element)))
+ (and post (< origin post)))
+ (beginning-of-line)
+ (let ((case-fold-search t)) (looking-at org-element--affiliated-re))
+ (cond
+ ((not (member-ignore-case (match-string 1)
+ org-element-parsed-keywords))
+ (throw 'objects-forbidden element))
+ ((< (match-end 0) origin)
+ (narrow-to-region (match-end 0) (line-end-position)))
+ ((and (match-beginning 2)
+ (>= origin (match-beginning 2))
+ (< origin (match-end 2)))
+ (narrow-to-region (match-beginning 2) (match-end 2)))
+ (t (throw 'objects-forbidden element)))
+ ;; Also change type to retrieve correct restrictions.
+ (setq type 'keyword))
+ ;; At an item, objects can only be located within tag, if any.
+ ((eq type 'item)
+ (let ((tag (org-element-property :tag element)))
+ (if (not tag) (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward tag (line-end-position))
+ (goto-char (match-beginning 0))
+ (if (and (>= origin (point)) (< origin (match-end 0)))
+ (narrow-to-region (point) (match-end 0))
+ (throw 'objects-forbidden element)))))
+ ;; At an headline or inlinetask, objects are located within
+ ;; their title.
+ ((memq type '(headline inlinetask))
+ (goto-char (org-element-property :begin element))
+ (skip-chars-forward "* ")
+ (if (and (>= origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element)))
+ ;; At a paragraph, a table-row or a verse block, objects are
+ ;; located within their contents.
+ ((memq type '(paragraph table-row verse-block))
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ ;; CBEG is nil for table rules.
+ (if (and cbeg cend (>= origin cbeg) (< origin cend))
+ (narrow-to-region cbeg cend)
+ (throw 'objects-forbidden element))))
+ ;; At a parsed keyword, objects are located within value.
+ ((eq type 'keyword)
+ (if (not (member (org-element-property :key element)
+ org-element-document-properties))
+ (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward ":")
+ (if (and (>= origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element))))
+ (t (throw 'objects-forbidden element)))
+ (goto-char (point-min))
+ (let ((restriction (org-element-restriction type))
+ (parent element)
+ (candidates 'initial))
+ (catch 'exit
+ (while (setq candidates
+ (org-element--get-next-object-candidates
+ 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 parent)
+ (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))
+ (obj-end (org-element-property :end object)))
+ (cond
+ ;; ORIGIN is after OBJECT, so skip it.
+ ((<= obj-end origin) (goto-char obj-end))
+ ;; ORIGIN is within a non-recursive object or at
+ ;; an object boundaries: Return that object.
+ ((or (not cbeg) (< origin cbeg) (>= origin cend))
+ (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)
+ (narrow-to-region (point) cend)
+ (org-element-put-property object :parent parent)
+ (setq parent object
+ restriction (org-element-restriction object)
+ candidates 'initial)))))))
+ parent))))))
+
+(defun 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))
diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el
index 3f8cc9c6d6..638da7861b 100644
--- a/lisp/org/org-entities.el
+++ b/lisp/org/org-entities.el
@@ -66,8 +66,8 @@ ASCII replacement Plain ASCII, no extensions. Symbols that cannot be
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'."
+If you define new entities here that require specific LaTeX
+packages to be loaded, add these packages to `org-latex-packages-alist'."
:group 'org-entities
:version "24.1"
:type '(repeat
@@ -154,6 +154,9 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("real" "\\Re" t "&real;" "R" "R" "ℜ")
("image" "\\Im" t "&image;" "I" "I" "ℑ")
("weierp" "\\wp" t "&weierp;" "P" "P" "℘")
+ ("ell" "\\ell" t "&ell;" "ell" "ell" "ℓ")
+ ("imath" "\\imath" t "&imath;" "[dotless i]" "dotless i" "ı")
+ ("jmath" "\\jmath" t "&jmath;" "[dotless j]" "dotless j" "ȷ")
"** Greek"
("Alpha" "A" nil "&Alpha;" "Alpha" "Alpha" "Α")
@@ -203,6 +206,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("upsilon" "\\upsilon" t "&upsilon;" "upsilon" "upsilon" "υ")
("Phi" "\\Phi" t "&Phi;" "Phi" "Phi" "Φ")
("phi" "\\phi" t "&phi;" "phi" "phi" "φ")
+ ("varphi" "\\varphi" t "&varphi;" "varphi" "varphi" "ɸ")
("Chi" "X" nil "&Chi;" "Chi" "Chi" "Χ")
("chi" "\\chi" t "&chi;" "chi" "chi" "χ")
("acutex" "\\acute x" t "&acute;x" "'x" "'x" "𝑥́")
@@ -212,10 +216,15 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("Omega" "\\Omega" t "&Omega;" "Omega" "Omega" "Ω")
("omega" "\\omega" t "&omega;" "omega" "omega" "ω")
("piv" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
+ ("varpi" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
("partial" "\\partial" t "&part;" "[partial differential]" "[partial differential]" "∂")
"** Hebrew"
("alefsym" "\\aleph" t "&alefsym;" "aleph" "aleph" "ℵ")
+ ("aleph" "\\aleph" t "&aleph;" "aleph" "aleph" "ℵ")
+ ("gimel" "\\gimel" t "&gimel;" "gimel" "gimel" "ℷ")
+ ("beth" "\\beth" t "&beth;" "beth" "beth" "ב")
+ ("dalet" "\\daleth" t "&daleth;" "dalet" "dalet" "ד")
"** Dead languages"
("ETH" "\\DH{}" nil "&ETH;" "D" "Ð" "Ð")
@@ -226,6 +235,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
"* Punctuation"
"** Dots and Marks"
("dots" "\\dots{}" nil "&hellip;" "..." "..." "…")
+ ("cdots" "\\cdots{}" t "&ctdot;" "..." "..." "⋯")
("hellip" "\\dots{}" nil "&hellip;" "..." "..." "…")
("middot" "\\textperiodcentered{}" nil "&middot;" "." "·" "·")
("iexcl" "!`" nil "&iexcl;" "!" "¡" "¡")
@@ -253,20 +263,23 @@ loaded, add these packages to `org-export-latex-packages-alist'."
"* Other"
"** Misc. (often used)"
("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
- ("vert" "\\vert{}" t "&#124;" "|" "|" "|")
+ ("vert" "\\vert{}" t "&vert;" "|" "|" "|")
("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
+ ("S" "\\S" nil "&sect;" "paragraph" "§" "§")
("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
("amp" "\\&" nil "&amp;" "&" "&" "&")
("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
- ("tilde" "\\~{}" nil "&tilde;" "~" "~" "~")
+ ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~")
("slash" "/" nil "/" "/" "/" "/")
("plus" "+" nil "+" "+" "+" "+")
("under" "\\_" nil "_" "_" "_" "_")
("equal" "=" nil "=" "=" "=" "=")
("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
+ ("dag" "\\dag{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
+ ("ddag" "\\ddag{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
"** Whitespace"
("nbsp" "~" nil "&nbsp;" " " " " " ")
@@ -297,6 +310,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("plusmn" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
("times" "\\texttimes{}" nil "&times;" "*" "×" "×")
("frasl" "/" nil "&frasl;" "/" "/" "⁄")
+ ("colon" "\\colon" t ":" ":" ":" ":")
("div" "\\textdiv{}" nil "&divide;" "/" "÷" "÷")
("frac12" "\\textonehalf{}" nil "&frac12;" "1/2" "½" "½")
("frac14" "\\textonequarter{}" nil "&frac14;" "1/4" "¼" "¼")
@@ -318,6 +332,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("prop" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
("proptp" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
("not" "\\textlnot{}" nil "&not;" "[angled dash]" "¬" "¬")
+ ("neg" "\\neg{}" t "&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]" "∨")
@@ -325,7 +340,9 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("cap" "\\cap" t "&cap;" "[intersection]" "[intersection]" "∩")
("cup" "\\cup" t "&cup;" "[union]" "[union]" "∪")
("int" "\\int" t "&int;" "[integral]" "[integral]" "∫")
+ ("therefore" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
("there4" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
+ ("because" "\\because" t "&because;" "[because]" "[because]" "∵")
("sim" "\\sim" t "&sim;" "~" "~" "∼")
("cong" "\\cong" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
("simeq" "\\simeq" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
@@ -334,8 +351,26 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("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]" "≡")
+
+ ("triangleq" "\\triangleq" t "&triangleq;" "[defined to]" "[defined to]" "≜")
("le" "\\le" t "&le;" "<=" "<=" "≤")
+ ("leq" "\\le" t "&le;" "<=" "<=" "≤")
("ge" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("geq" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("lessgtr" "\\lessgtr" t "&lessgtr;" "[less than or greater than]" "[less than or greater than]" "≶")
+ ("lesseqgtr" "\\lesseqgtr" t "&lesseqgtr;" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚")
+ ("ll" "\\ll" t "&Lt;" "<<" "<<" "≪")
+ ("Ll" "\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("lll" "\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("gg" "\\gg" t "&Gt;" ">>" ">>" "≫")
+ ("Gg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("ggg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("prec" "\\prec" t "&pr;" "[precedes]" "[precedes]" "≺")
+ ("preceq" "\\preceq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("preccurlyeq" "\\preccurlyeq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("succ" "\\succ" t "&sc;" "[succeeds]" "[succeeds]" "≻")
+ ("succeq" "\\succeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
+ ("succcurlyeq" "\\succcurlyeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
("sub" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
("subset" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
("sup" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
@@ -344,9 +379,12 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("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]" "⊇")
+ ("setminus" "\\setminus" t "&setminus;" "\" "\" "⧵")
("forall" "\\forall" t "&forall;" "[for all]" "[for all]" "∀")
("exist" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
("exists" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
+ ("nexist" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
+ ("nexists" "\\nexists" t "&exist;" "[there does not exists]" "[there does not 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]" "∈")
@@ -365,6 +403,8 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("rfloor" "\\rfloor" t "&rfloor;" "[right floor]" "[right floor]" "⌋")
("lang" "\\langle" t "&lang;" "<" "<" "⟨")
("rang" "\\rangle" t "&rang;" ">" ">" "⟩")
+ ("hbar" "\\hbar" t "&hbar;" "hbar" "hbar" "ℏ")
+ ("mho" "\\mho" t "&mho;" "mho" "mho" "℧")
"** Arrows"
("larr" "\\leftarrow" t "&larr;" "<-" "<-" "←")
@@ -435,7 +475,8 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("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]" "✓")
+ ("check" "\\checkmark" t "&checkmark;" "[checkmark]" "[checkmark]" "✓")
+ ("checkmark" "\\checkmark" t "&check;" "[checkmark]" "[checkmark]" "✓")
"** Miscellaneous (seldom used)"
("para" "\\P{}" nil "&para;" "[pilcrow]" "¶" "¶")
@@ -450,7 +491,8 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("rlm" "" nil "&rlm;" "" "" "‏")
"** Smilies"
- ("smile" "\\smile" t "&#9786;" ":-)" ":-)" "⌣")
+ ("smile" "\\smile" t "&smile;" ":-)" ":-)" "⌣")
+ ("frown" "\\frown" t "&frown;" ":-(" ":-(" "⌢")
("smiley" "\\smiley{}" nil "&#9786;" ":-)" ":-)" "☺")
("blacksmile" "\\blacksmiley{}" nil "&#9787;" ":-)" ":-)" "☻")
("sad" "\\frownie{}" nil "&#9785;" ":-(" ":-(" "☹")
@@ -462,10 +504,11 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("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]" "◊")
+ ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("Diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("loz" "\\lozenge" t "&loz;" "[lozenge]" "[lozenge]" "⧫")
)
"Default entities used in Org-mode to produce special characters.
For details see `org-entities-user'.")
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index 606db0814c..d64fd0e1ac 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -202,7 +202,7 @@ set the properties in the `org-column' face. For example, set
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."
+`org-colview-xemacs.el' in Org's contrib/ directory for details."
:group 'org-faces)
(defface org-column-title
@@ -217,12 +217,6 @@ column view defines special faces for each outline level. See the file
"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)))
@@ -264,7 +258,7 @@ column view defines special faces for each outline level. See the file
'((((class color) (background light)) (:foreground "Purple" :underline t))
(((class color) (background dark)) (:foreground "Cyan" :underline t))
(t (:underline t)))
- "Face for links."
+ "Face for footnotes."
:group 'org-faces)
(defface org-ellipsis
@@ -394,6 +388,14 @@ determines if it is a foreground or a background color."
(string :tag "Color")
(sexp :tag "Face")))))
+(defface org-priority ;; 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 priority cookies."
+ :group 'org-faces)
+
(defcustom org-priority-faces nil
"Faces for specific Priorities.
This is a list of cons cells, with priority character in the car
@@ -685,25 +687,28 @@ month and 365.24 days for a year)."
(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 88) (background light)) (:background "#eeeeee"))
+ (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C"))
+ (((class color) (min-colors 16) (background light)) (:background "#eeeeee"))
+ (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C"))
(((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 'mode-line
- nil)
+ (org-compatible-face 'mode-line nil)
"Face for tag(s) in the mode-line when filtering the agenda."
:group 'org-faces)
+(defface org-agenda-filter-regexp
+ (org-compatible-face 'mode-line nil)
+ "Face for regexp(s) in the mode-line when filtering the agenda."
+ :group 'org-faces)
+
(defface org-agenda-filter-category
- (org-compatible-face 'mode-line
- nil)
- "Face for tag(s) in the mode-line when filtering the agenda."
+ (org-compatible-face 'mode-line nil)
+ "Face for categories(s) in the mode-line when filtering the agenda."
:group 'org-faces)
(defface org-time-grid ;; originally copied from font-lock-variable-name-face
@@ -718,20 +723,17 @@ month and 365.24 days for a year)."
"Face used to show the current time in the time grid.")
(defface org-agenda-diary
- (org-compatible-face 'default
- nil)
+ (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)
+ (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)
+ (org-compatible-face 'default nil)
"Face used to show events computed from a S-expression."
:group 'org-faces)
@@ -757,7 +759,7 @@ level org-n-level-faces"
:version "24.1"
:type 'boolean)
-(defface org-latex-and-export-specials
+(defface org-latex-and-related
(let ((font (cond ((assq :inherit custom-face-attributes)
'(:inherit underline))
(t '(:underline t)))))
@@ -770,8 +772,24 @@ level org-n-level-faces"
(((class color) (background dark))
(:foreground "burlywood"))
(t (,@font))))
- "Face used to highlight math latex and other special exporter stuff."
- :group 'org-faces)
+ "Face used to highlight LaTeX data, entities and sub/superscript."
+ :group 'org-faces
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(defface org-macro
+ (org-compatible-face 'org-latex-and-related nil)
+ "Face for macros."
+ :group 'org-faces
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(defface org-tag-group
+ (org-compatible-face 'org-tag nil)
+ "Face for group tags."
+ :group 'org-faces
+ :version "24.4"
+ :package-version '(Org . "8.0"))
(org-copy-face 'mode-line 'org-mode-line-clock
"Face used for clock display in mode line.")
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index 4cde24bf57..3c0d97c3a4 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -42,8 +42,6 @@
(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" ())
@@ -87,7 +85,7 @@
"Regular expression matching the definition of a footnote.")
(defconst org-footnote-forbidden-blocks
- '("ascii" "beamer" "comment" "docbook" "example" "html" "latex" "odt" "src")
+ '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src")
"Names of blocks where footnotes are not allowed.")
(defgroup org-footnote nil
@@ -96,15 +94,19 @@
: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.
+ "Outline heading containing footnote definitions.
+
+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."
+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 ignored."
:group 'org-footnote
:type '(choice
(string :tag "Collect footnotes under heading")
@@ -136,13 +138,13 @@ will be used to define the footnote at the reference position."
"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
+nil Prompt the user for each label.
+t Create unique labels of the form [fn:1], [fn:2], etc.
+confirm Like t, but let the user edit the created value.
+ 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]"
+plain Automatically create plain number labels like [1]."
:group 'org-footnote
:type '(choice
(const :tag "Prompt for label" nil)
@@ -164,6 +166,7 @@ The main values of this variable can be set with in-buffer options:
#+STARTUP: nofnadjust"
:group 'org-footnote
:type '(choice
+ (const :tag "No adjustment" nil)
(const :tag "Renumber" renumber)
(const :tag "Sort" sort)
(const :tag "Renumber and Sort" t)))
@@ -182,8 +185,6 @@ extracted will be filled again."
(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
@@ -230,13 +231,7 @@ positions, and the definition, when inlined."
(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)))
+ (not (org-inside-latex-macro-p)))
(list label beg end
;; Definition: ensure this is an inline footnote first.
(and (or (not label) (match-string 1))
@@ -257,11 +252,12 @@ 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))))
+ ;; Footnotes definitions are separated by new headlines, another
+ ;; footnote definition or 2 blank lines.
+ (let ((lim (save-excursion
+ (re-search-backward
+ (concat org-outline-regexp-bol
+ "\\|^\\([ \t]*\n\\)\\{2,\\}") nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
(let ((label (org-match-string-no-properties 1))
(beg (match-beginning 0))
@@ -277,7 +273,7 @@ otherwise."
(re-search-forward
(concat org-outline-regexp-bol "\\|"
org-footnote-definition-re "\\|"
- "^[ \t]*$") bound 'move))
+ "^\\([ \t]*\n\\)\\{2,\\}") bound 'move))
(match-beginning 0)
(point)))))
(list label beg end
@@ -602,38 +598,15 @@ With prefix arg SPECIAL, offer additional commands in a menu."
(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)
+(defun org-footnote-normalize (&optional sort-only)
"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.
+normalizes them to the usual [N] format.
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'."
+referenced sequence."
;; This is based on Paul's function, but rewritten.
;;
;; Re-create `org-with-limited-levels', but not limited to Org
@@ -643,17 +616,12 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
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)))
+ (if org-odd-levels-only (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)
+ (count 0)
+ ins-point ref ref-table)
(save-excursion
;; 1. Find every footnote reference, extract the definition, and
;; collect that data in REF-TABLE. If SORT-ONLY is nil, also
@@ -675,15 +643,10 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; 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))
+ (insert (format "[%d]" marker))
(and inlinep
org-footnote-fill-after-inline-note-extraction
(org-fill-paragraph)))
@@ -691,22 +654,9 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; 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)))
+ (let ((def (or (nth 3 ref) ; Inline definition.
(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)
+ (push (list lbl marker def
;; Reference beginning position is a marker
;; to preserve it during further buffer
;; modifications.
@@ -728,14 +678,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(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))))
+ ((derived-mode-p 'org-mode))
(t
;; Remove any left-over tag in the buffer, if one is set up.
(when org-footnote-tag-for-non-org-mode-files
@@ -753,14 +696,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(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))))
+ (setq ins-point (point-marker))
;; 3. Clean-up REF-TABLE.
(setq ref-table
(delq nil
@@ -791,26 +727,22 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; 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)
+ ((or (not (derived-mode-p 'org-mode)) org-footnote-section)
;; 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))
+ (if (not (derived-mode-p 'org-mode))
+ (progn (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")))
(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")))
+ (insert "* " org-footnote-section "\n"))
(set-marker ins-point nil)
;; Insert the footnotes, separated by a blank line.
(insert
@@ -820,10 +752,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(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)))
+ (unless (eobp) (insert "\n\n")))
;; Each footnote definition has to be inserted at the end of
;; the section where its first reference belongs.
(t
diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el
index 4419fdbe85..e368a14e2a 100644
--- a/lisp/org/org-gnus.el
+++ b/lisp/org/org-gnus.el
@@ -43,8 +43,7 @@
(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))
+(org-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.
@@ -66,6 +65,12 @@ this variable to `t'."
:version "24.1"
:type 'boolean)
+(defcustom org-gnus-no-server nil
+ "Should Gnus be started using `gnus-no-server'?"
+ :group 'org-gnus
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
;; Install the link type
(org-add-link-type "gnus" 'org-gnus-open)
@@ -287,7 +292,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(defun org-gnus-no-new-news ()
"Like `M-x gnus' but doesn't check for new news."
- (if (not (gnus-alive-p)) (gnus)))
+ (if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus))))
(provide 'org-gnus)
diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index 8465ba45a2..eba90376de 100644
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -85,6 +85,12 @@ today's agenda, even if they are not scheduled."
:version "24.1"
:type 'character)
+(defcustom org-habit-show-done-always-green nil
+ "Non-nil means DONE days will always be green in the consistency graph.
+It will be green even if it was done after the deadline."
+ :group 'org-habit
+ :type 'boolean)
+
(defface org-habit-clear-face
'((((background light)) (:background "#8270f9"))
(((background dark)) (:background "blue")))
@@ -272,8 +278,9 @@ Habits are assigned colors on the following basis:
(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)))))
+ ((and org-habit-show-done-always-green donep)
+ '(org-habit-ready-face . org-habit-ready-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.
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index ecf67f72f3..f1fa05bdc7 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -186,7 +186,7 @@ the link."
:type 'boolean)
(defcustom org-id-locations-file (convert-standard-filename
- "~/.emacs.d/.org-id-locations")
+ (concat user-emacs-directory ".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
@@ -343,7 +343,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
(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)))
+ (let* ((etime (org-reverse-string (org-id-time-to-b36)))
(postfix (if org-id-include-domain
(progn
(require 'message)
@@ -376,9 +376,6 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
(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
@@ -432,7 +429,7 @@ and time is the usual three-integer representation of time."
(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 (org-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))))
@@ -440,6 +437,7 @@ and time is the usual three-integer representation of time."
;; Storing ID locations (files)
+;;;###autoload
(defun org-id-update-id-locations (&optional files silent)
"Scan relevant files for IDs.
Store the relation between files and corresponding IDs.
@@ -530,7 +528,9 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(org-id-hash-to-alist org-id-locations)
org-id-locations)))
(with-temp-file org-id-locations-file
- (print out (current-buffer))))))
+ (let ((print-level nil)
+ (print-length nil))
+ (print out (current-buffer)))))))
(defun org-id-locations-load ()
"Read the data from `org-id-locations-file'."
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index 9719a1fa03..44311e3882 100644
--- a/lisp/org/org-indent.el
+++ b/lisp/org/org-indent.el
@@ -88,7 +88,7 @@ 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.
+ "Non-nil means the last deletion operated on a headline.
It is modified by `org-indent-notify-modified-headline'.")
@@ -147,8 +147,8 @@ useful to make it ever so slightly different."
(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))))
+ (org-with-silent-modifications
+ (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
;;;###autoload
(define-minor-mode org-indent-mode
@@ -182,11 +182,11 @@ during idle time."
(org-set-local 'org-hide-leading-stars-before-indent-mode
org-hide-leading-stars)
(org-set-local 'org-hide-leading-stars t))
- (add-hook 'filter-buffer-substring-functions
- (lambda (fun start end delete)
- (org-indent-remove-properties-from-string
- (funcall fun start end delete)))
- nil t)
+ (org-add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (org-indent-remove-properties-from-string
+ (funcall fun start end delete)))
+ nil t)
(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)
@@ -213,8 +213,7 @@ during idle time."
(remove-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
- (funcall fun start end delete)))
- t)
+ (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)
@@ -343,50 +342,50 @@ stopped."
;; 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))))))))))
+ (org-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.
@@ -413,7 +412,7 @@ 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
+ ;; If a headline was modified or inserted, set properties until
;; next headline.
(if (or org-indent-modified-headline-flag
(save-excursion
diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el
index 43913acacd..ca7572bcc3 100644
--- a/lisp/org/org-inlinetask.el
+++ b/lisp/org/org-inlinetask.el
@@ -27,31 +27,25 @@
;;; 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.
+;; 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.
;;
-;; 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.
+;; 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.
;;
-;; 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.
+;; 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
@@ -111,69 +105,6 @@ 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)
@@ -328,89 +259,6 @@ If the task has an end part, also demote it."
(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
@@ -467,7 +315,8 @@ Either remove headline and meta data, or do special formatting."
((= end start))
;; Inlinetask was folded: expand it.
((get-char-property (1+ start) 'invisible)
- (org-show-entry))
+ (outline-flag-region start end nil)
+ (org-cycle-hide-drawers 'children))
(t (outline-flag-region start end t)))))
(defun org-inlinetask-remove-END-maybe ()
@@ -476,9 +325,6 @@ Either remove headline and meta data, or do special formatting."
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))
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index 4747648162..4a3d471f06 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT gnu DOT org>
+;; Bastien Guerry <[email protected]>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
@@ -94,6 +94,11 @@
(defvar org-ts-regexp)
(defvar org-ts-regexp-both)
+(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" ())
+
(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))
@@ -107,10 +112,6 @@
(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))
@@ -118,15 +119,21 @@
(declare-function org-remove-if "org" (predicate seq))
(declare-function org-reduced-level "org" (L))
(declare-function org-show-subtree "org" ())
+(declare-function org-sort-remove-invisible "org" (S))
(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" ())
+
+(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-export-string-as "ox"
+ (string backend &optional body-only ext-plist))
+
@@ -154,6 +161,7 @@ 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
+ :group 'org-cycle
:type '(choice
(const :tag "Never" nil)
(const :tag "With cursor in plain list (recommended)" t)
@@ -209,14 +217,26 @@ Valid values are ?. and ?\). To get both terminators, use t."
(const :tag "paren like in \"2)\"" ?\))
(const :tag "both" t)))
-(defcustom org-alphabetical-lists nil
+(define-obsolete-variable-alias 'org-alphabetical-lists
+ 'org-list-allow-alphabetical "24.4") ; Since 8.0
+(defcustom org-list-allow-alphabetical 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."
+counters like \"[@c]\" will be recognized.
+
+This variable needs to be set before org.el is loaded. If you
+need to make a change while Emacs is running, use the customize
+interface or run the following code after updating it:
+
+ \(when (featurep 'org-element) (load \"org-element\" t t))"
:group 'org-plain-lists
:version "24.1"
- :type 'boolean)
+ :type 'boolean
+ :set (lambda (var val)
+ (when (featurep 'org-element) (load "org-element" t t))
+ (set var val)))
(defcustom org-list-two-spaces-after-bullet-regexp nil
"A regular expression matching bullets that should have 2 spaces after them.
@@ -230,7 +250,9 @@ spaces instead of one after the bullet in each item of the list."
(const :tag "never" nil)
(regexp)))
-(defcustom org-empty-line-terminates-plain-lists nil
+(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists
+ 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0
+(defcustom org-list-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
@@ -282,7 +304,9 @@ This hook runs even if checkbox rule in
implement alternative ways of collecting statistics
information.")
-(defcustom org-hierarchical-checkbox-statistics t
+(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
+ 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0
+(defcustom org-checkbox-hierarchical-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
@@ -290,7 +314,9 @@ with the word \"recursive\" in the value."
:group 'org-plain-lists
:type 'boolean)
-(defcustom org-description-max-indent 20
+(org-defvaralias 'org-description-max-indent
+ 'org-list-description-max-indent) ;; Since 8.0
+(defcustom org-list-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."
@@ -333,7 +359,7 @@ list, obtained by prompting the user."
(string :tag "Format"))))
(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
- "docbook" "html" "latex" "odt")
+ "html" "latex" "odt")
"Names of blocks where lists are not allowed.
Names must be in lower case.")
@@ -348,10 +374,10 @@ specifically, type `block' is determined by the variable
;;; Predicates and regexps
-(defconst org-list-end-re (if org-empty-line-terminates-plain-lists "^[ \t]*\n"
+(defconst org-list-end-re (if org-list-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'.")
+It depends on `org-list-empty-line-terminates-plain-lists'.")
(defconst org-list-full-item-re
(concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)"
@@ -371,7 +397,7 @@ group 4: description tag")
((= org-plain-list-ordered-item-terminator ?\)) ")")
((= org-plain-list-ordered-item-terminator ?.) "\\.")
(t "[.)]")))
- (alpha (if org-alphabetical-lists "\\|[A-Za-z]" "")))
+ (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" "")))
(concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term
"\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")))
@@ -385,7 +411,7 @@ group 4: description tag")
(save-excursion
(goto-char (match-end 0))
(let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?"
- (if org-alphabetical-lists
+ (if org-list-allow-alphabetical
"\\([0-9]+\\|[A-Za-z]\\)"
"[0-9]+")
"\\][ \t]*\\)")))
@@ -642,8 +668,7 @@ Assume point is at an item."
(save-excursion
(catch 'exit
(while t
- (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
- (org-get-indentation))))
+ (let ((ind (org-get-indentation)))
(cond
((<= (point) lim-up)
;; At upward limit: if we ended at an item, store it,
@@ -651,18 +676,10 @@ Assume point is at an item."
;; Jump to part 2.
(throw 'exit
(setq itm-lst
- (if (or (not (looking-at item-re))
- (get-text-property (point) 'org-example))
+ (if (not (looking-at item-re))
(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)
@@ -711,8 +728,7 @@ Assume point is at an item."
;; position of items in END-LST-2.
(catch 'exit
(while t
- (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
- (org-get-indentation))))
+ (let ((ind (org-get-indentation)))
(cond
((>= (point) lim-down)
;; At downward limit: this is de facto the end of the
@@ -720,12 +736,6 @@ Assume point is at an item."
;; 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)
@@ -1097,8 +1107,9 @@ It determines the number of whitespaces to append by looking at
org-list-two-spaces-after-bullet-regexp bullet))
" "
" ")))
- (string-match "\\S-+\\([ \t]*\\)" bullet)
- (replace-match spaces nil nil bullet 1))))
+ (if (string-match "\\S-+\\([ \t]*\\)" bullet)
+ (replace-match spaces nil nil bullet 1)
+ bullet))))
(defun org-list-swap-items (beg-A beg-B struct)
"Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
@@ -1208,7 +1219,7 @@ some heuristics to guess the result."
(point))))))))
(cond
;; Trivial cases where there should be none.
- ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0)
+ ((or org-list-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
@@ -1613,7 +1624,7 @@ bullets between START and END."
STRUCT is list structure. PREVS is the alist of previous items,
as returned by `org-list-prevs-alist'."
- (and org-alphabetical-lists
+ (and org-list-allow-alphabetical
(catch 'exit
(let ((item first) (ascii 64) (case-fold-search nil))
;; Pretend that bullets are uppercase and check if alphabet
@@ -1851,9 +1862,10 @@ Initial position of cursor is restored after the changes."
(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)
+ ;; Shift the indentation between END and BEG by DELTA. If
+ ;; MAX-IND is non-nil, ensure that no line will be indented
+ ;; more than that number. Start from the line before END.
+ (lambda (end beg delta max-ind)
(goto-char end)
(skip-chars-backward " \r\t\n")
(beginning-of-line)
@@ -1867,7 +1879,8 @@ Initial position of cursor is restored after the changes."
;; Shift only non-empty lines.
((org-looking-at-p "^[ \t]*\\S-")
(let ((i (org-get-indentation)))
- (org-indent-line-to (+ i delta)))))
+ (org-indent-line-to
+ (if max-ind (min (+ i delta) max-ind) (+ i delta))))))
(forward-line -1)))))
(modify-item
(function
@@ -1903,53 +1916,60 @@ Initial position of cursor is restored after the changes."
(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
+ ;; at item, and END-LIST, 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)
+ (dolist (e old-struct)
+ (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)))
;; 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.
+ ;; same amount of indentation. Each slice follow the pattern
+ ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in
+ ;; reverse order.
(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)))
+ (itemp (assq up struct))
+ (item (if itemp up (cdr (assq up end-list))))
+ (ind (cdr (assq item itm-shift)))
+ ;; If we're not at an item, there's a child of the item
+ ;; point belongs to above. Make sure this slice isn't
+ ;; moved within that child by specifying a maximum
+ ;; indentation.
+ (max-ind (and (not itemp)
+ (+ (org-list-get-ind item struct)
+ (length (org-list-get-bullet item struct))
+ org-list-indent-offset))))
+ (push (list down up ind max-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))
+ (dolist (e sliced-struct)
+ (unless (and (zerop (nth 2 e)) (not (nth 3 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)))))
;; 4. Go back to initial position and clean marker.
(goto-char origin)
(move-marker origin nil)))
@@ -2148,7 +2168,7 @@ the item, so this really moves item trees."
(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"))
+ (user-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))
@@ -2169,7 +2189,7 @@ the item, so this really moves item trees."
(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"))
+ (user-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)))
@@ -2203,9 +2223,8 @@ item is invisible."
;; 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))
+ " :: ")))
+ (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)
@@ -2214,6 +2233,7 @@ item is invisible."
(string-match "[.)]" (match-string 1))))
(match-beginning 4)
(match-end 0)))
+ (if desc (backward-char 1))
t)))))
(defun org-list-repair ()
@@ -2429,7 +2449,7 @@ With optional prefix argument ALL, do this for the whole buffer."
(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)
+ (or (not org-checkbox-hierarchical-statistics)
(string-match "\\<recursive\\>"
(or (org-entry-get nil "COOKIE_DATA") ""))))
(bounds (if all
@@ -2771,7 +2791,7 @@ Return t at each successful move."
(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 (user-error "Cannot move item"))))
t))))
(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
@@ -2787,13 +2807,14 @@ 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:
+be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the
+detailed 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.
+x By \"checked\" status of a check list.
Capital letters will reverse the sort order.
@@ -2801,7 +2822,10 @@ 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."
+COMPARE-FUNC to compare entries.
+
+Sorting is done against the visible part of the headlines, it
+ignores hidden links."
(interactive "P")
(let* ((case-func (if with-case 'identity 'downcase))
(struct (org-list-struct))
@@ -2809,13 +2833,16 @@ COMPARE-FUNC to compare entries."
(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)))))
+ (or sorting-type
+ (progn
+ (message
+ "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:")
+ (read-char-exclusive))))
+ (getkey-func
+ (or 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)
@@ -2826,10 +2853,11 @@ COMPARE-FUNC to compare entries."
(sort-func (cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
- ((= dcst ?t) '<)))
+ ((= dcst ?t) '<)
+ ((= dcst ?x) 'string<)))
(next-record (lambda ()
(skip-chars-forward " \r\t\n")
- (beginning-of-line)))
+ (or (eobp) (beginning-of-line))))
(end-record (lambda ()
(goto-char (org-list-get-item-end-before-blank
(point) struct))))
@@ -2838,21 +2866,28 @@ COMPARE-FUNC to compare entries."
(when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
(cond
((= dcst ?n)
- (string-to-number (buffer-substring (match-end 0)
- (point-at-eol))))
+ (string-to-number
+ (org-sort-remove-invisible
+ (buffer-substring (match-end 0) (point-at-eol)))))
((= dcst ?a)
(funcall case-func
- (buffer-substring (match-end 0) (point-at-eol))))
+ (org-sort-remove-invisible
+ (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))
+ ((or (save-excursion
+ (re-search-forward org-ts-regexp (point-at-eol) t))
+ (save-excursion (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 ?x) (or (and (stringp (match-string 1))
+ (match-string 1))
+ ""))
((= dcst ?f)
(if getkey-func
(let ((value (funcall getkey-func)))
@@ -3021,9 +3056,8 @@ for this list."
(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)
+ (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)")
+ (if maybe (throw 'exit nil)
(error "Don't know how to transform this list"))))
(let* ((name (match-string 1))
(transform (intern (match-string 2)))
@@ -3037,13 +3071,11 @@ for this list."
(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)))
+ (plain-list (buffer-substring-no-properties top-point bottom-point))
beg txt)
(unless (fboundp transform)
(error "No such transformation function %s" transform))
- (let ((txt (funcall transform list)))
+ (let ((txt (funcall transform plain-list)))
;; Find the insertion place
(save-excursion
(goto-char (point-min))
@@ -3200,65 +3232,24 @@ items."
(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)
+LIST is as string representing the list to transform, as Org
+syntax. Return converted list as a string."
+ (require 'ox-latex)
+ (org-export-string-as list 'latex t))
+
+(defun org-list-to-html (list)
"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)))
+LIST is as string representing the list to transform, as Org
+syntax. Return converted list as a string."
+ (require 'ox-html)
+ (org-export-string-as list 'html t))
(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)))
+LIST is as string representing the list to transform, as Org
+syntax. Return converted list as a string."
+ (require 'ox-texinfo)
+ (org-export-string-as list 'texinfo t))
(defun org-list-to-subtree (list &optional params)
"Convert LIST into an Org subtree.
diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
new file mode 100644
index 0000000000..fa74d8341b
--- /dev/null
+++ b/lisp/org/org-macro.el
@@ -0,0 +1,191 @@
+;;; org-macro.el --- Macro Replacement Code for Org Mode
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <[email protected]>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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:
+
+;; Macros are expanded with `org-macro-replace-all', which relies
+;; internally on `org-macro-expand'.
+
+;; Default templates for expansion are stored in the buffer-local
+;; variable `org-macro-templates'. This variable is updated by
+;; `org-macro-initialize-templates', which recursively calls
+;; `org-macro--collect-macros' in order to read setup files.
+
+;; Along with macros defined through #+MACRO: keyword, default
+;; templates include the following hard-coded macros:
+;; {{{time(format-string)}}}, {{{property(node-property)}}},
+;; {{{input-file}}} and {{{modification-time(format-string)}}}.
+
+;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}},
+;; {{{email}}} and {{{title}}} macros.
+
+;;; Code:
+(require 'org-macs)
+
+(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-remove-double-quotes "org" (s))
+(declare-function org-mode "org" ())
+(declare-function org-file-contents "org" (file &optional noerror))
+(declare-function org-with-wide-buffer "org-macs" (&rest body))
+
+;;; Variables
+
+(defvar org-macro-templates nil
+ "Alist containing all macro templates in current buffer.
+Associations are in the shape of (NAME . TEMPLATE) where NAME
+stands for macro's name and template for its replacement value,
+both as strings. This is an internal variable. Do not set it
+directly, use instead:
+
+ #+MACRO: name template")
+(make-variable-buffer-local 'org-macro-templates)
+
+
+;;; Functions
+
+(defun org-macro--collect-macros ()
+ "Collect macro definitions in current buffer and setup files.
+Return an alist containing all macro templates found."
+ (let* (collect-macros ; For byte-compiler.
+ (collect-macros
+ (lambda (files templates)
+ ;; Return an alist of macro templates. FILES is a list of
+ ;; setup files names read so far, used to avoid circular
+ ;; dependencies. TEMPLATES is the alist collected so far.
+ (let ((case-fold-search t))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let ((val (org-element-property :value element)))
+ (if (equal (org-element-property :key element) "MACRO")
+ ;; Install macro in TEMPLATES.
+ (when (string-match
+ "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val)
+ (let* ((name (match-string 1 val))
+ (template (or (match-string 2 val) ""))
+ (old-cell (assoc name templates)))
+ (if old-cell (setcdr old-cell template)
+ (push (cons name template) templates))))
+ ;; Enter setup file.
+ (let ((file (expand-file-name
+ (org-remove-double-quotes val))))
+ (unless (member file files)
+ (with-temp-buffer
+ (org-mode)
+ (insert (org-file-contents file 'noerror))
+ (setq templates
+ (funcall collect-macros (cons file files)
+ templates)))))))))))
+ templates))))
+ (funcall collect-macros nil nil)))
+
+(defun org-macro-initialize-templates ()
+ "Collect macro templates defined in current buffer.
+Templates are stored in buffer-local variable
+`org-macro-templates'. In addition to buffer-defined macros, the
+function installs the following ones: \"property\",
+\"time\". and, if the buffer is associated to a file,
+\"input-file\" and \"modification-time\"."
+ (let* ((templates (org-macro--collect-macros))
+ (update-templates
+ (lambda (cell)
+ (let ((old-template (assoc (car cell) templates)))
+ (if old-template (setcdr old-template (cdr cell))
+ (push cell templates))))))
+ ;; Install hard-coded macros.
+ (mapc (lambda (cell) (funcall update-templates cell))
+ (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))")
+ (cons "time" "(eval (format-time-string \"$1\"))")))
+ (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (when (and visited-file (file-exists-p visited-file))
+ (mapc (lambda (cell) (funcall update-templates cell))
+ (list (cons "input-file" (file-name-nondirectory visited-file))
+ (cons "modification-time"
+ (format "(eval (format-time-string \"$1\" '%s))"
+ (prin1-to-string
+ (nth 5 (file-attributes visited-file)))))))))
+ (setq org-macro-templates templates)))
+
+(defun org-macro-expand (macro templates)
+ "Return expanded MACRO, as a string.
+MACRO is an object, obtained, for example, with
+`org-element-context'. TEMPLATES is an alist of templates used
+for expansion. See `org-macro-templates' for a buffer-local
+default value. Return nil if no template was found."
+ (let ((template
+ ;; Macro names are case-insensitive.
+ (cdr (assoc-string (org-element-property :key macro) templates t))))
+ (when template
+ (let ((value (replace-regexp-in-string
+ "\\$[0-9]+"
+ (lambda (arg)
+ (or (nth (1- (string-to-number (substring arg 1)))
+ (org-element-property :args macro))
+ ;; No argument: remove place-holder.
+ ""))
+ template nil 'literal)))
+ ;; 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 ""))))))
+
+(defun org-macro-replace-all (templates)
+ "Replace all macros in current buffer by their expansion.
+TEMPLATES is an alist of templates used for expansion. See
+`org-macro-templates' for a buffer-local default value."
+ (save-excursion
+ (goto-char (point-min))
+ (let (record)
+ (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
+ (let ((object (org-element-context)))
+ (when (eq (org-element-type object) 'macro)
+ (let* ((value (org-macro-expand object templates))
+ (begin (org-element-property :begin object))
+ (signature (list begin
+ object
+ (org-element-property :args object))))
+ ;; Avoid circular dependencies by checking if the same
+ ;; macro with the same arguments is expanded at the same
+ ;; position twice.
+ (if (member signature record)
+ (error "Circular macro expansion: %s"
+ (org-element-property :key object))
+ (when value
+ (push signature record)
+ (delete-region
+ begin
+ ;; Preserve white spaces after the macro.
+ (progn (goto-char (org-element-property :end object))
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Leave point before replacement in case of recursive
+ ;; expansions.
+ (save-excursion (insert value)))))))))))
+
+
+(provide 'org-macro)
+;;; org-macro.el ends here
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 57b2d8a577..0083d293ed 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -33,7 +33,9 @@
(eval-and-compile
(unless (fboundp 'declare-function)
- (defmacro declare-function (fn file &optional arglist fileonly)))
+ (defmacro declare-function (fn file &optional arglist fileonly)
+ `(autoload ',fn ,file)))
+
(if (>= emacs-major-version 23)
(defsubst org-char-to-string(c)
"Defsubst to decode UTF-8 character values in emacs 23 and beyond."
@@ -63,14 +65,6 @@
`(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))
@@ -87,16 +81,6 @@
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)
- (inhibit-modification-hooks t))
- ,@body))))
-(def-edebug-spec org-unmodified (body))
-
(defun org-substitute-posix-classes (re)
"Substitute posix classes in regular expression RE."
(let ((ss re))
@@ -126,14 +110,18 @@ Also, do not record undo information."
(org-move-to-column ,col)))))
(def-edebug-spec org-preserve-lc (body))
-;; Copied from bookmark.el
-(defmacro org-with-buffer-modified-unmodified (&rest body)
+;; Use `org-with-silent-modifications' to ignore cosmetic changes and
+;; `org-unmodified' to ignore real text modifications
+(defmacro org-unmodified (&rest body)
"Run BODY while preserving the buffer's `buffer-modified-p' state."
(org-with-gensyms (was-modified)
`(let ((,was-modified (buffer-modified-p)))
(unwind-protect
- (progn ,@body)
- (set-buffer-modified-p ,was-modified)))))
+ (let ((buffer-undo-list t)
+ (inhibit-modification-hooks t))
+ ,@body)
+ (set-buffer-modified-p ,was-modified)))))
+(def-edebug-spec org-unmodified (body))
(defmacro org-without-partial-completion (&rest body)
`(if (and (boundp 'partial-completion-mode)
@@ -176,46 +164,17 @@ We use a macro so that the test can happen at compilation time."
(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)
+(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)
+ (,buf2 ,buffer)
(,undo1 buffer-undo-list)
- (,undo2 (with-current-buffer ,_buffer buffer-undo-list))
+ (,undo2 (with-current-buffer ,buffer buffer-undo-list))
,c1 ,c2)
- ,@_body
+ ,@body
(when org-agenda-allow-remote-undo
(setq ,c1 (org-verify-change-for-undo
,undo1 (with-current-buffer ,buf1 buffer-undo-list))
@@ -427,6 +386,13 @@ the value in cdr."
(cons (list (car flat) (cadr flat))
(org-make-parameter-alist (cddr flat)))))
+;;;###autoload
+(defmacro org-load-noerror-mustsuffix (file)
+ "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it."
+ (if (featurep 'xemacs)
+ `(load ,file 'noerror)
+ `(load ,file 'noerror nil nil 'mustsuffix)))
+
(provide 'org-macs)
;;; org-macs.el ends here
diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el
index 48767b7b79..7d6e4ec9fb 100644
--- a/lisp/org/org-mhe.el
+++ b/lisp/org/org-mhe.el
@@ -30,6 +30,7 @@
;;; Code:
+(require 'org-macs)
(require 'org)
;; Customization variables
diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el
index 293d2a000c..a43896bdd7 100644
--- a/lisp/org/org-mobile.el
+++ b/lisp/org/org-mobile.el
@@ -76,6 +76,13 @@ org-agenda-text-search-extra-files
:group 'org-mobile
:type 'directory)
+(defcustom org-mobile-allpriorities "A B C"
+ "Default set of priority cookies for the index file."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string
+ :group 'org-mobile)
+
(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
@@ -276,7 +283,7 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
(list f))
(t nil)))
org-mobile-files)))
- (files (delete
+ (files (delq
nil
(mapcar (lambda (f)
(unless (and (not (string= org-mobile-files-exclude-regexp ""))
@@ -300,8 +307,6 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
(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 target directory.
@@ -314,23 +319,24 @@ create all custom agenda views, for upload to the mobile phone."
(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)))
+ (save-restriction
+ (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))))
(setq org-agenda-buffer-name org-agenda-curbuf-name
org-agenda-this-buffer-name org-agenda-curbuf-name))
(redraw-display)
@@ -463,7 +469,7 @@ agenda view showing the flagged items."
(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")
+ (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n")
(when (file-exists-p (expand-file-name
org-mobile-directory "agendas.org"))
(insert "* [[file:agendas.org][Agenda Views]]\n"))
@@ -1061,10 +1067,13 @@ be returned that indicates what went wrong."
(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
+ (if (org-at-heading-p) ; if false we are in top-level of file
(progn
+ ;; Workaround a `org-insert-heading-respect-content' bug
+ ;; which prevents correct insertion when point is invisible
+ (org-show-subtree)
(end-of-line 1)
- (org-insert-heading-respect-content t)
+ (org-insert-heading-respect-content '(16) t)
(org-demote))
(beginning-of-line)
(insert "* "))
@@ -1073,7 +1082,7 @@ be returned that indicates what went wrong."
((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
+ (if (org-at-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)
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index fac43e4bc4..c8a6c86cad 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -656,11 +656,11 @@ This means, between the beginning of line and the point."
["All Clear" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
- (replace-match "[ ]"))))]
+ (replace-match "[ ] "))))]
["All Set" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
- (replace-match "[X]"))))]
+ (replace-match "[X] "))))]
["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
["All Remove" (org-mouse-for-each-item
(lambda ()
@@ -1056,7 +1056,7 @@ This means, between the beginning of line and the point."
["Convert" org-agenda-convert-date
(org-agenda-check-type nil 'agenda 'timeline)]
"--"
- ["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
+ ["Create iCalendar file" org-icalendar-combine-agenda-files t])
"--"
["Day View" org-agenda-day-view
:active (org-agenda-check-type nil 'agenda)
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el
index 7ae80b02e2..77f68f4d85 100644
--- a/lisp/org/org-pcomplete.el
+++ b/lisp/org/org-pcomplete.el
@@ -35,9 +35,8 @@
(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))
+ (&optional string))
(declare-function org-get-buffer-tags "org" ())
(declare-function org-get-tags "org" ())
(declare-function org-buffer-property-keys "org"
@@ -46,7 +45,6 @@
;;;; Customization variables
-;; Unused. Cf org-completion.
(defgroup org-complete nil
"Outline-based notes management and organizer."
:tag "Org"
@@ -110,11 +108,11 @@ When completing for #+STARTUP, for example, this function returns
(let ((thing (org-thing-at-point)))
(cond
((string= "file-option" (car thing))
- (concat (car thing) "/" (downcase (cdr thing))))
+ (concat (car thing)
+ (and (cdr thing) (concat "/" (downcase (cdr thing))))))
((string= "block-option" (car thing))
(concat (car thing) "/" (downcase (cdr thing))))
- (t
- (car thing)))))
+ (t (car thing)))))
(defun org-parse-arguments ()
"Parse whitespace separated arguments in the current region."
@@ -141,21 +139,86 @@ When completing for #+STARTUP, for example, this function returns
(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
+(defvar org-options-keywords) ; From org.el
+(defvar org-element-block-name-alist) ; From org-element.el
+(defvar org-element-affiliated-keywords) ; From org-element.el
+(declare-function org-get-export-keywords "org" ())
(defun pcomplete/org-mode/file-option ()
"Complete against all valid file options."
- (require 'org-exp)
+ (require 'org-element)
(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)))
+ (append (mapcar (lambda (keyword) (concat keyword " "))
+ org-options-keywords)
+ (mapcar (lambda (keyword) (concat keyword ": "))
+ org-element-affiliated-keywords)
+ (let (block-names)
+ (dolist (block-info org-element-block-name-alist block-names)
+ (let ((name (car block-info)))
+ (push (format "END_%s" name) block-names)
+ (push (concat "BEGIN_"
+ name
+ ;; Since language is compulsory in
+ ;; source blocks, add a space.
+ (and (equal name "SRC") " "))
+ block-names)
+ (push (format "ATTR_%s: " name) block-names))))
+ (mapcar (lambda (keyword) (concat keyword ": "))
+ (org-get-export-keywords))))
(substring pcomplete-stub 2)))
+(defun pcomplete/org-mode/file-option/author ()
+ "Complete arguments for the #+AUTHOR file option."
+ (pcomplete-here (list user-full-name)))
+
+(defvar org-time-stamp-formats)
+(defun pcomplete/org-mode/file-option/date ()
+ "Complete arguments for the #+DATE file option."
+ (pcomplete-here (list (format-time-string (car org-time-stamp-formats)))))
+
+(defun pcomplete/org-mode/file-option/email ()
+ "Complete arguments for the #+EMAIL file option."
+ (pcomplete-here (list user-mail-address)))
+
+(defvar org-export-exclude-tags)
+(defun pcomplete/org-mode/file-option/exclude_tags ()
+ "Complete arguments for the #+EXCLUDE_TAGS file option."
+ (require 'ox)
+ (pcomplete-here
+ (and org-export-exclude-tags
+ (list (mapconcat 'identity org-export-exclude-tags " ")))))
+
+(defvar org-file-tags)
+(defun pcomplete/org-mode/file-option/filetags ()
+ "Complete arguments for the #+FILETAGS file option."
+ (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " "))))
+
+(defvar org-export-default-language)
+(defun pcomplete/org-mode/file-option/language ()
+ "Complete arguments for the #+LANGUAGE file option."
+ (require 'ox)
+ (pcomplete-here
+ (pcomplete-uniqify-list
+ (list org-export-default-language "en"))))
+
+(defvar org-default-priority)
+(defvar org-highest-priority)
+(defvar org-lowest-priority)
+(defun pcomplete/org-mode/file-option/priorities ()
+ "Complete arguments for the #+PRIORITIES file option."
+ (pcomplete-here (list (format "%c %c %c"
+ org-highest-priority
+ org-lowest-priority
+ org-default-priority))))
+
+(defvar org-export-select-tags)
+(defun pcomplete/org-mode/file-option/select_tags ()
+ "Complete arguments for the #+SELECT_TAGS file option."
+ (require 'ox)
+ (pcomplete-here
+ (and org-export-select-tags
+ (list (mapconcat 'identity org-export-select-tags " ")))))
+
(defvar org-startup-options)
(defun pcomplete/org-mode/file-option/startup ()
"Complete arguments for the #+STARTUP file option."
@@ -170,37 +233,57 @@ When completing for #+STARTUP, for example, this function returns
(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"))
+(defvar org-tag-alist)
+(defun pcomplete/org-mode/file-option/tags ()
+ "Complete arguments for the #+TAGS file option."
+ (pcomplete-here
+ (list
+ (mapconcat (lambda (x)
+ (cond
+ ((eq :startgroup (car x)) "{")
+ ((eq :endgroup (car x)) "}")
+ ((eq :grouptags (car x)) ":")
+ ((eq :newline (car x)) "\\n")
+ ((cdr x) (format "%s(%c)" (car x) (cdr x)))
+ (t (car x))))
+ org-tag-alist " "))))
(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"))
+ (pcomplete-here
+ (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (list (or (and visited-file
+ (file-name-sans-extension
+ (file-name-nondirectory visited-file)))
+ (buffer-name (buffer-base-buffer)))))))
-(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"))
+(declare-function org-export-backend-options "org-export" (cl-x))
+(defun pcomplete/org-mode/file-option/options ()
+ "Complete arguments for the #+OPTIONS file option."
+ (while (pcomplete-here
+ (pcomplete-uniqify-list
+ (append
+ ;; Hard-coded OPTION items always available.
+ '("H:" "\\n:" "num:" "timestamp:" "arch:" "author:" "c:"
+ "creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:"
+ "inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:"
+ "|:" "tags:" "tasks:" "<:" "todo:")
+ ;; OPTION items from registered back-ends.
+ (let (items)
+ (dolist (backend (org-bound-and-true-p
+ org-export--registered-backends))
+ (dolist (option (org-export-backend-options backend))
+ (let ((item (nth 2 option)))
+ (when item (push (concat item ":") items)))))
+ items))))))
+
+(defun pcomplete/org-mode/file-option/infojs_opt ()
+ "Complete arguments for the #+INFOJS_OPT file option."
+ (while (pcomplete-here
+ (pcomplete-uniqify-list
+ (mapcar (lambda (item) (format "%s:" (car item)))
+ (org-bound-and-true-p org-html-infojs-opts-table))))))
(defun pcomplete/org-mode/file-option/bind ()
"Complete arguments for the #+BIND file option, which are variable names."
@@ -243,7 +326,7 @@ This needs more work, to handle headings with lots of spaces in them."
(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)
+ (match-string-no-properties 3))
tbl))
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
@@ -291,7 +374,7 @@ This needs more work, to handle headings with lots of spaces in them."
(cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
(pcomplete-here cpllist
(substring pcomplete-stub 1)
- (unless (or (not (delete
+ (unless (or (not (delq
nil
(mapcar (lambda(x)
(string-match (substring pcomplete-stub 1) x))
@@ -313,16 +396,16 @@ Complete a language in the first field, the header arguments and switches."
'("-n" "-r" "-l"
":cache" ":colnames" ":comments" ":dir" ":eval" ":exports"
":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames"
- ":session" ":shebang" ":tangle" ":var"))))
+ ":session" ":shebang" ":tangle" ":tangle-mode" ":var"))))
(defun pcomplete/org-mode/block-option/clocktable ()
"Complete keywords in a clocktable line."
- (while (pcomplete-here '(":maxlevel" ":scope"
+ (while (pcomplete-here '(":maxlevel" ":scope" ":lang"
":tstart" ":tend" ":block" ":step"
":stepskip0" ":fileskip0"
":emphasize" ":link" ":narrow" ":indent"
":tcolumns" ":level" ":compact" ":timestamp"
- ":formula" ":formatter"))))
+ ":formula" ":formatter" ":wstart" ":mstart"))))
(defun org-pcomplete-case-double (list)
"Return list with both upcase and downcase version of all strings in LIST."
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
index 02d747d544..384a6f6847 100644
--- a/lisp/org/org-plot.el
+++ b/lisp/org/org-plot.el
@@ -30,7 +30,6 @@
;;; Code:
(require 'org)
-(require 'org-exp)
(require 'org-table)
(eval-when-compile
(require 'cl))
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 18c6d6d70a..84b1176a70 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -2,7 +2,7 @@
;;
;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
;;
-;; Authors: Bastien Guerry <bzg AT gnu DOT org>
+;; Authors: Bastien Guerry <[email protected]>
;; Daniel M German <dmg AT uvic DOT org>
;; Sebastian Rose <sebastian_rose AT gmx DOT de>
;; Ross Patterson <me AT rpatterson DOT net>
@@ -91,11 +91,6 @@
;; 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:
;;
@@ -155,8 +150,7 @@ for `org-protocol-the-protocol' and sub-protocols defined in
;;; 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-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.
@@ -271,12 +265,14 @@ Here is an example:
This is usually a single character string but can also be a
string with two characters."
:group 'org-protocol
- :type 'string)
+ :type '(choice (const nil) (string)))
-(defcustom org-protocol-data-separator "/+"
+(defcustom org-protocol-data-separator "/+\\|\\?"
"The default data separator to use.
This should be a single regexp string."
:group 'org-protocol
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type 'string)
;;; Helper functions:
@@ -297,7 +293,7 @@ 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 "/+"))
+ (let* ((sep (or separator "/+\\|\\?"))
(split-parts (split-string data sep)))
(if unhexify
(if (fboundp unhexify)
@@ -391,32 +387,14 @@ The sub-protocol used to reach this function is set in
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:
+This function detects an URL, title and optional text, separated
+by '/'. The location for a browser's bookmark looks like this:
javascript:location.href='org-protocol://capture://'+ \\
encodeURIComponent(location.href)+'/' \\
@@ -431,14 +409,20 @@ But you may prepend the encoded URL with a character and a slash like so:
Now template ?b will be used."
(if (and (boundp 'org-stored-links)
- (fboundp 'org-capture)
- (org-protocol-do-capture info 'org-capture))
+ (org-protocol-do-capture info))
(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'."
+(defun org-protocol-convert-query-to-plist (query)
+ "Convert query string that is part of url to property list."
+ (if query
+ (apply 'append (mapcar (lambda (x)
+ (let ((c (split-string x "=")))
+ (list (intern (concat ":" (car c))) (cadr c))))
+ (split-string query "&")))))
+
+(defun org-protocol-do-capture (info)
+ "Support `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))
@@ -449,8 +433,8 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
(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)
+ (query (or (org-protocol-convert-query-to-plist (cadddr parts)) ""))
+ (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link
(setq org-stored-links
(cons (list url title) org-stored-links))
(kill-new orglink)
@@ -458,9 +442,10 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
:link url
:description title
:annotation orglink
- :initial region)
+ :initial region
+ :query query)
(raise-frame)
- (funcall capture-func nil template)))
+ (funcall 'org-capture nil template)))
(defun org-protocol-open-source (fname)
"Process an org-protocol://open-source:// style url.
@@ -588,9 +573,9 @@ as filename."
(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."
+The visited file needs to be part of a publishing project in
+`org-publish-project-alist' for this to work. The function
+delegates most of the work to `org-protocol-create'."
(interactive)
(require 'org-publish)
(let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
@@ -600,10 +585,11 @@ most of the work."
(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
+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
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index 501d30ab1d..6ec3adc471 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT gnu DOT org>
+;; Bastien Guerry <[email protected]>
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
@@ -64,6 +64,30 @@ there are kept outside the narrowed region."
(const :tag "from `lang' element")
(const :tag "from `style' element")))))
+(defcustom org-edit-src-turn-on-auto-save nil
+ "Non-nil means turn `auto-save-mode' on when editing a source block.
+This will save the content of the source code editing buffer into
+a newly created file, not the base buffer for this source block.
+
+If you want to regularily save the base buffer instead of the source
+code editing buffer, see `org-edit-src-auto-save-idle-delay' instead."
+ :group 'org-edit-structure
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-edit-src-auto-save-idle-delay 0
+ "Delay before saving a source code buffer back into its base buffer.
+When a positive integer N, save after N seconds of idle time.
+When 0 (the default), don't auto-save.
+
+If you want to save the source code buffer itself, don't use this.
+Check `org-edit-src-turn-on-auto-save' instead."
+ :group 'org-edit-structure
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
(defcustom org-coderef-label-format "(ref:%s)"
"The default coderef format.
This format string will be used to search for coderef labels in literal
@@ -155,7 +179,7 @@ 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++)
+ ("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++)
("screen" . shell-script))
"Alist mapping languages to their major mode.
The key is the language name, the value is the string that should
@@ -174,6 +198,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(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-c\C-k" 'org-edit-src-abort)
(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save)
(defvar org-edit-src-force-single-line nil)
@@ -186,11 +211,15 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(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
+(defcustom 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.")
+the existing edit buffer."
+ :group 'org-edit-structure
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
(defvar org-src-babel-info nil)
@@ -202,6 +231,7 @@ This minor mode is turned on in two situations:
There is a mode hook, and keybindings for `org-edit-src-exit' and
`org-edit-src-save'")
+(defvar org-edit-src-code-timer nil)
(defun org-edit-src-code (&optional context code edit-buffer-name)
"Edit the source CODE block at point.
The code is copied to a separate buffer and the appropriate mode
@@ -241,8 +271,8 @@ the display of windows containing the Org buffer and the code buffer."
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)")
+ "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort")
+ "Exit with C-c ' (C-c and single quote) -- C-c C-k to abort")
code (or code (buffer-substring-no-properties beg end))
lang (or (cdr (assoc (nth 2 info) org-src-lang-modes))
(nth 2 info))
@@ -336,12 +366,33 @@ the display of windows containing the Org buffer and the code buffer."
(org-src-mode)
(set-buffer-modified-p nil)
(setq buffer-file-name nil)
+ (when org-edit-src-turn-on-auto-save
+ (setq buffer-auto-save-file-name
+ (concat (make-temp-name "org-src-")
+ (format-time-string "-%Y-%d-%m") ".txt")))
(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)))
+ (funcall edit-prep-func full-info)))
+ (or org-edit-src-code-timer
+ (setq org-edit-src-code-timer
+ (unless (zerop org-edit-src-auto-save-idle-delay)
+ (run-with-idle-timer
+ org-edit-src-auto-save-idle-delay t
+ (lambda ()
+ (cond
+ ((and (string-match "\*Org Src" (buffer-name))
+ (buffer-modified-p))
+ (org-edit-src-save))
+ ((not
+ (delq nil (mapcar
+ (lambda (b)
+ (string-match "\*Org Src" (buffer-name b)))
+ (buffer-list))))
+ (cancel-timer org-edit-src-code-timer)
+ (setq org-edit-src-code-timer)))))))))
+ t)))
(defun org-edit-src-continue (e)
"Continue editing source blocks." ;; Fixme: be more accurate
@@ -420,7 +471,7 @@ the fragment in the Org-mode buffer."
(col (current-column))
(case-fold-search t)
(msg (substitute-command-keys
- "Edit, then exit with C-c ' (C-c and single quote)"))
+ "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort"))
(org-mode-p (derived-mode-p 'org-mode))
(beg (make-marker))
(end (make-marker))
@@ -520,10 +571,8 @@ the language, a switch telling if the content should be in a 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)
@@ -699,14 +748,19 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(set-buffer-modified-p nil))
(org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
(if (eq context 'save) (save-buffer)
+ (with-current-buffer buffer
+ (set-buffer-modified-p nil))
(kill-buffer buffer))
(goto-char beg)
(when allow-write-back-p
- (delete-region beg (max beg end))
- (unless (string-match "\\`[ \t]*\\'" code)
- (insert code))
- (goto-char beg)
- (if single (just-one-space)))
+ (let ((buffer-undo-list t))
+ (delete-region beg (max beg end))
+ (unless (string-match "\\`[ \t]*\\'" code)
+ (insert code))
+ ;; Make sure the overlay stays in place
+ (when (eq context 'save) (move-overlay ovl beg (point)))
+ (goto-char beg)
+ (if single (just-one-space))))
(if (memq t (mapcar (lambda (overlay)
(eq (overlay-get overlay 'invisible)
'org-hide-block))
@@ -714,16 +768,26 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
;; 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))))
+ (when allow-write-back-p
+ (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)))
+ (when org-edit-src-code-timer
+ (cancel-timer org-edit-src-code-timer)
+ (setq org-edit-src-code-timer 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))))
+(defun org-edit-src-abort ()
+ "Abort editing of the src code and return to the Org buffer."
+ (interactive)
+ (let (org-edit-src-allow-write-back-p)
+ (org-edit-src-exit 'exit)))
+
(defmacro org-src-in-org-buffer (&rest body)
`(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg)
(save-window-excursion
@@ -743,9 +807,11 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(defun org-edit-src-save ()
"Save parent buffer with current state source-code buffer."
(interactive)
- (org-src-in-org-buffer (save-buffer)))
+ (if (string-match "Fixed Width" (buffer-name))
+ (user-error "Use C-c ' to save and exit, C-c C-k to abort editing")
+ (org-src-in-org-buffer (save-buffer))))
-(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang))
+(declare-function org-babel-tangle "ob-tangle" (&optional arg target-file lang))
(defun org-src-tangle (arg)
"Tangle the parent buffer."
@@ -829,9 +895,9 @@ issued in the language major mode buffer."
(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."
+Alter code block according to what TAB does in the language major mode."
(and org-src-tab-acts-natively
+ (org-in-src-block-p)
(not (equal this-command 'org-shifttab))
(let ((org-src-strip-leading-and-trailing-blank-lines nil))
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 00b2eb4d02..246cf8d605 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -38,13 +38,11 @@
(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 org-export-string-as "ox"
+ (string backend &optional body-only ext-plist))
(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)
@@ -54,6 +52,8 @@ 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.")
+(defvar org-table-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ")
+
(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
@@ -94,6 +94,22 @@ this variable requires a restart of Emacs to become effective."
| | |
"))
"Templates for radio tables in different major modes.
+Each template must define lines that will be treated as a comment and that
+must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\"
+lines where \"%n\" will be replaced with the name of the table during
+insertion of the tempate. The transformed table will later be inserted
+between these lines.
+
+The template should also contain a minimal table in a multiline comment.
+If multiline comments are not possible in the buffer language,
+you can pack it into a string that will not be used when the code
+is compiled or executed. Above the table will you need a line with
+the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to
+convert the table into a data structure useful in the
+language of the buffer. Check the manual for the section on
+\"Translator functions\", and more generally check out
+http://orgmode.org/manual/Tables-in-arbitrary-syntax.html#Tables-in-arbitrary-syntax
+
All occurrences of %n in a template will be replaced with the name of the
table, obtained by prompting the user."
:group 'org-table
@@ -112,7 +128,7 @@ table, obtained by prompting the user."
:type 'string)
(defcustom org-table-number-regexp
- "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$"
+ "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$"
"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.
@@ -136,10 +152,10 @@ Other options offered by the customize interface are more restrictive."
"^[-+]?\\([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\\)$")
+ (const :tag "Very General Number-Like, including hex and Calc radix"
+ "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
+ (const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark"
+ "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
(string :tag "Regexp:")))
(defcustom org-table-number-fraction 0.5
@@ -419,6 +435,40 @@ available parameters."
(org-split-string (match-string 1 line)
"[ \t]*|[ \t]*")))))))
+(defvar org-table-clean-did-remove-column nil) ; dynamically scoped
+(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."
+ (let ((special (if maybe-quoted
+ "^[ \t]*| *\\\\?[\#!$*_^/ ] *|"
+ "^[ \t]*| *[\#!$*_^/ ] *|"))
+ (ignore (if maybe-quoted
+ "^[ \t]*| *\\\\?[!$_^/] *|"
+ "^[ \t]*| *[!$_^/] *|")))
+ (setq org-table-clean-did-remove-column
+ (not (memq nil
+ (mapcar
+ (lambda (line)
+ (or (string-match org-table-hline-regexp line)
+ (string-match special line)))
+ lines))))
+ (delq nil
+ (mapcar
+ (lambda (line)
+ (cond
+ ((or (org-table-colgroup-line-p line) ;; colgroup info
+ (org-table-cookie-line-p line) ;; formatting cookies
+ (and org-table-clean-did-remove-column
+ (string-match ignore line))) ;; non-exportable data
+ nil)
+ ((and org-table-clean-did-remove-column
+ (or (string-match "^\\([ \t]*\\)|-+\\+" line)
+ (string-match "^\\([ \t]*\\)|[^|]*|" line)))
+ ;; remove the first column
+ (replace-match "\\1|" t nil line))
+ (t line)))
+ lines))))
+
(defconst org-table-translate-regexp
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
"Match a reference that needs translation, for reference display.")
@@ -503,7 +553,7 @@ nil When nil, the command tries to be smart and figure out the
- 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")
+ (interactive "r\nP")
(let* ((beg (min beg0 end0))
(end (max beg0 end0))
re)
@@ -539,7 +589,7 @@ nil When nil, the command tries to be smart and figure out the
((equal separator '(16)) "^\\|\t")
((integerp separator)
(if (< separator 1)
- (error "Number of spaces in separator must be >= 1")
+ (user-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)
@@ -579,9 +629,7 @@ 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)
+ (unless (org-at-table-p) (user-error "No table at point"))
(org-table-align) ;; make sure we have everything we need
(let* ((beg (org-table-begin))
(end (org-table-end))
@@ -598,13 +646,13 @@ extension of the given file name, and finally on the variable
(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")))
+ (user-error "File not written")))
(if (file-directory-p file)
- (error "This is a directory path, not a file"))
+ (user-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"))
+ (user-error "Please specify a file name that is different from current"))
(setq fileext (concat (file-name-extension file) "$"))
(unless format
(setq deffmt-readable
@@ -641,7 +689,7 @@ extension of the given file name, and finally on the variable
skipcols i0)))
(unless (fboundp transform)
- (error "No such transformation function %s" transform))
+ (user-error "No such transformation function %s" transform))
(setq txt (funcall transform table params))
(with-current-buffer (find-file-noselect file)
@@ -652,7 +700,7 @@ extension of the given file name, and finally on the variable
(save-buffer))
(kill-buffer buf)
(message "Export done."))
- (error "TABLE_EXPORT_FORMAT invalid"))))
+ (user-error "TABLE_EXPORT_FORMAT invalid"))))
(defvar org-table-aligned-begin-marker (make-marker)
"Marker at the beginning of the table last aligned.
@@ -760,7 +808,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(error
(kill-region beg end)
(org-table-create org-table-default-size)
- (error "Empty table - created default table")))
+ (user-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.
@@ -787,7 +835,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(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\""
+ (user-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
@@ -860,7 +908,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(org-goto-line winstartline)
(setq winstart (point-at-bol))
(org-goto-line linepos)
- (set-window-start (selected-window) winstart 'noforce)
+ (when (eq (window-buffer (selected-window)) (current-buffer))
+ (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)
@@ -978,7 +1027,7 @@ Before doing so, re-align the table if necessary."
(progn
(re-search-backward "|" (org-table-begin))
(re-search-backward "|" (org-table-begin)))
- (error (error "Cannot move to previous table field")))
+ (error (user-error "Cannot move to previous table field")))
(while (looking-at "|\\(-\\|[ \t]*$\\)")
(re-search-backward "|" (org-table-begin)))
(if (looking-at "| ?")
@@ -994,7 +1043,7 @@ With numeric argument N, move N-1 fields forward first."
(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")
+ (user-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))))
@@ -1055,7 +1104,7 @@ 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))
+ (field (save-excursion (org-table-get-field)))
(non-empty (string-match "[^ \t]" field))
(beg (org-table-begin))
(orig-n n)
@@ -1091,7 +1140,7 @@ copying. In the case of a timestamp, increment by one day."
(org-table-maybe-recalculate-line))
(org-table-align)
(org-move-to-column col))
- (error "No non-empty field found"))))
+ (user-error "No non-empty field found"))))
(defun org-table-check-inside-data-field (&optional noerror)
"Is point inside a table data field?
@@ -1103,7 +1152,7 @@ This actually throws an error, so it aborts the current command."
(looking-at "[ \t]*$"))
(if noerror
nil
- (error "Not in table data field"))
+ (user-error "Not in table data field"))
t))
(defvar org-table-clip nil
@@ -1286,7 +1335,7 @@ However, when FORCE is non-nil, create new columns if necessary."
"Insert a new column into the table."
(interactive)
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-error "Not at a table"))
(org-table-find-dataline)
(let* ((col (max 1 (org-table-current-column)))
(beg (org-table-begin))
@@ -1326,7 +1375,7 @@ However, when FORCE is non-nil, create new columns if necessary."
(if (and (org-at-table-p)
(not (org-at-table-hline-p)))
t
- (error
+ (user-error
"Please position cursor in a data line for column operations")))))
(defun org-table-line-to-dline (line &optional above)
@@ -1356,7 +1405,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
"Delete a column from the table."
(interactive)
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
(let* ((col (org-table-current-column))
@@ -1400,7 +1449,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
"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"))
+ (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
(let* ((col (org-table-current-column))
@@ -1411,9 +1460,9 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(linepos (org-current-line))
(colpos (if left (1- col) (1+ col))))
(if (and left (= col 1))
- (error "Cannot move column further left"))
+ (user-error "Cannot move column further left"))
(if (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
- (error "Cannot move column further right"))
+ (user-error "Cannot move column further right"))
(goto-char beg)
(while (< (point) end)
(if (org-at-table-hline-p)
@@ -1461,7 +1510,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(beginning-of-line tonew)
(unless (org-at-table-p)
(goto-char pos)
- (error "Cannot move row further"))
+ (user-error "Cannot move row further"))
(setq hline2p (looking-at org-table-hline-regexp))
(goto-char pos)
(beginning-of-line 1)
@@ -1486,7 +1535,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
With prefix ARG, insert below the current line."
(interactive "P")
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-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
@@ -1508,7 +1557,7 @@ With prefix ARG, insert below the current line."
With prefix ABOVE, insert above the current line."
(interactive "P")
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-error "Not at a table"))
(when (eobp) (insert "\n") (backward-char 1))
(if (not (string-match "|[ \t]*$" (org-current-line-string)))
(org-table-align))
@@ -1558,7 +1607,7 @@ In particular, this does handle wide and invisible characters."
"Delete the current row or horizontal line from the table."
(interactive)
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-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)))
@@ -1710,7 +1759,7 @@ 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!"))
+ (user-error "First cut/copy a region to paste!"))
(org-table-check-inside-data-field)
(let* ((clip org-table-clip)
(line (org-current-line))
@@ -1796,11 +1845,16 @@ will be transposed as
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))))))
+ (let* ((table (delete 'hline (org-table-to-lisp)))
+ (contents (mapcar (lambda (p)
+ (let ((tp table))
+ (mapcar
+ (lambda (rown)
+ (prog1
+ (pop (car tp))
+ (setq tp (cdr tp))))
+ table)))
+ (car table))))
(delete-region (org-table-begin) (org-table-end))
(insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
contents ""))
@@ -1839,7 +1893,7 @@ blank, and the content is appended to the field above."
nlines)
(org-table-cut-region (region-beginning) (region-end))
(if (> (length (car org-table-clip)) 1)
- (error "Region must be limited to single column"))
+ (user-error "Region must be limited to single column"))
(setq nlines (if arg
(if (< arg 1)
(+ (length org-table-clip) arg)
@@ -2008,12 +2062,12 @@ If NLAST is a number, only the NLAST fields will actually be summed."
(setq col (org-table-current-column))
(goto-char (org-table-begin))
(unless (re-search-forward "^[ \t]*|[^-]" nil t)
- (error "No table data"))
+ (user-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"))
+ (user-error "No table data"))
(org-table-goto-column col)
(setq end (point))))
(let* ((items (apply 'append (org-table-copy-region beg end)))
@@ -2031,7 +2085,7 @@ If NLAST is a number, only the NLAST fields will actually be summed."
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))))
+ (format "%.0f:%02.0f:%02.0f" h m s))))
(kill-new sres)
(if (org-called-interactively-p 'interactive)
(message "%s"
@@ -2098,7 +2152,7 @@ When NAMED is non-nil, look for a named equation."
(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")))
+ (message "Formula not replaced")))
(name (or name ref))
(org-table-may-need-update nil)
(stored (cdr (assoc scol stored-list)))
@@ -2122,7 +2176,7 @@ When NAMED is non-nil, look for a named equation."
;; remove formula
(setq stored-list (delq (assoc scol stored-list) stored-list))
(org-table-store-formulas stored-list)
- (error "Formula removed"))
+ (user-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))
@@ -2207,7 +2261,7 @@ When NAMED is non-nil, look for a named equation."
(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))
+ (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
(push scol seen))))))
(nreverse eq-alist)))
@@ -2231,7 +2285,7 @@ For all numbers larger than LIMIT, shift them by DELTA."
(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"
+ (user-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)
@@ -2338,7 +2392,7 @@ If yes, store the formula and apply it."
(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"))))))
+ (user-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.
@@ -2363,7 +2417,7 @@ 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"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
(beg (org-table-begin))
(end (org-table-end))
@@ -2382,13 +2436,13 @@ of the new mark."
(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'"
+ (user-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")))
+ (user-error "Not at a table data line")))
(unless have-col
(org-table-goto-column 1)
(org-table-insert-column)
@@ -2483,7 +2537,7 @@ not overwrite the stored one."
(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"))
+ (or eq (user-error "No equation active for current field"))
(org-table-get-field nil eq)
(org-table-align)
(setq org-table-may-need-update t))
@@ -2557,7 +2611,10 @@ not overwrite the stored one."
fields)))
(if (eq numbers t)
(setq fields (mapcar
- (lambda (x) (number-to-string (string-to-number x)))
+ (lambda (x)
+ (if (string-match "\\S-" x)
+ (number-to-string (string-to-number x))
+ x))
fields)))
(setq ndown (1- ndown))
(setq form (copy-sequence formula)
@@ -2612,7 +2669,7 @@ not overwrite the stored one."
(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)))
+ (user-error "Spreadsheet error: invalid reference \"%s\"" form)))
;; Insert simple ranges
(while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
(setq form
@@ -2630,11 +2687,12 @@ not overwrite the stored one."
(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\""
+ (unless x (user-error "Invalid field specifier \"%s\""
(match-string 0 form)))
(setq form (replace-match
(save-match-data
- (org-table-make-reference x nil numbers lispp))
+ (org-table-make-reference
+ x keep-empty numbers lispp))
t t form)))
(if lispp
@@ -2646,12 +2704,23 @@ not overwrite the stored one."
(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
+ (user-error "Calc does not seem to be installed, and is needed to evaluate the formula"))
+ ;; Use <...> time-stamps so that Calc can handle them
(setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form))
+ ;; I18n-ize local time-stamps by setting (system-time-locale "C")
+ (when (string-match org-ts-regexp2 form)
+ (let* ((ts (match-string 0 form))
+ (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts))))
+ (system-time-locale "C")
+ (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))
+ (cdr org-time-stamp-formats))
+ (car org-time-stamp-formats))))
+ (setq form (replace-match (format-time-string tf tsp) t t 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)))
+ (calc-eval (cons form org-tbl-calc-modes)
+ (when (and (not keep-empty) 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))
@@ -2667,7 +2736,7 @@ $xyz-> %s
@r$c-> %s
$1-> %s\n" orig formula form0 form))
(if (listp ev)
- (princ (format " %s^\nError: %s"
+ (princ (format " %s^\nError: %s"
(make-string (car ev) ?\-) (nth 1 ev)))
(princ (format "Result: %s\nFormat: %s\nFinal: %s"
ev (or fmt "NONE")
@@ -2678,7 +2747,7 @@ $1-> %s\n" orig formula form0 form))
(unless (let (inhibit-redisplay)
(y-or-n-p "Debugging Formula. Continue to next? "))
(org-table-align)
- (error "Abort"))
+ (user-error "Abort"))
(delete-window bw)
(message "")))
(if (listp ev) (setq fmt nil ev "#ERROR"))
@@ -2716,7 +2785,7 @@ in the buffer and column1 and column2 are table column numbers."
(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))
+ (user-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))
@@ -2784,7 +2853,7 @@ and TABLE is a vector with line types."
;; 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))
+ (user-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)))
@@ -2798,7 +2867,7 @@ and TABLE is a vector with line types."
(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)
+ (user-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)))
@@ -2818,41 +2887,56 @@ and TABLE is a vector with line types."
(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))
+ (user-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"
+ (user-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")
+ (user-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
+LISPP non-nil means to return something appropriate for a Lisp
+list, 'literal is for the format specifier L."
+ ;; Calc nan (not a number) is used for the conversion of the empty
+ ;; field to a reference for several reasons: (i) It is accepted in a
+ ;; Calc formula (e. g. "" or "()" would result in a Calc error).
+ ;; (ii) In a single field (not in range) it can be distinguished
+ ;; from "(nan)" which is the reference made from a single field
+ ;; containing "nan".
+ (if (stringp elements)
+ ;; field reference
(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 ")"))
+ (if (and (eq elements "") (not keep-empty))
+ ""
+ (prin1-to-string
+ (if numbers (string-to-number elements) elements))))
+ (if (string-match "\\S-" elements)
+ (progn
+ (when numbers (setq elements (number-to-string
+ (string-to-number elements))))
+ (concat "(" elements ")"))
+ (if (or (not keep-empty) numbers) "(0)" "nan")))
+ ;; range reference
(unless keep-empty
(setq elements
(delq nil
(mapcar (lambda (x) (if (string-match "\\S-" x) x nil))
elements))))
- (setq elements (or elements '("0")))
+ (setq elements (or elements '())) ; if delq returns nil then we need '()
(if lispp
(mapconcat
(lambda (x)
@@ -2862,11 +2946,33 @@ LISPP means to return something appropriate for a Lisp list."
elements " ")
(concat "[" (mapconcat
(lambda (x)
- (if numbers (number-to-string (string-to-number x)) x))
+ (if (string-match "\\S-" x)
+ (if numbers
+ (number-to-string (string-to-number x))
+ x)
+ (if (or (not keep-empty) numbers) "0" "nan")))
elements
",") "]"))))
;;;###autoload
+(defun org-table-set-constants ()
+ "Set `org-table-formula-constants-local' in the current buffer."
+ (let (cst consts const-str)
+ (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))
+ (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
+ (if (assoc-string (match-string 1 e) cst)
+ (setq cst (delete (assoc-string (match-string 1 e) cst) cst)))
+ (push (cons (match-string 1 e) (match-string 2 e)) cst)))
+ (setq org-table-formula-constants-local cst)))))))
+
+;;;###autoload
(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.
@@ -2879,7 +2985,7 @@ 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"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(if (or (eq all 'iterate) (equal all '(16)))
(org-table-iterate)
(org-table-get-specials)
@@ -2902,7 +3008,7 @@ known that the table will be realigned a little later anyway."
(car x)) 1)
(cdr x)))
(if (assoc (car x) eqlist1)
- (error "\"%s=\" formula tries to overwrite existing formula for column %s"
+ (user-error "\"%s=\" formula tries to overwrite existing formula for column %s"
lhs1 (car x))))
(cons
(org-table-formula-handle-first/last-rc (car x))
@@ -2947,7 +3053,7 @@ known that the table will be realigned a little later anyway."
(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))
+ (user-error "Several field/range formulas try to set %s" name1))
(push name1 seen-fields)
(and (not a)
@@ -2956,7 +3062,7 @@ known that the table will be realigned a little later anyway."
(condition-case nil
(aref org-table-dlines
(string-to-number (match-string 1 name)))
- (error (error "Invalid row number in %s"
+ (error (user-error "Invalid row number in %s"
name)))
(string-to-number (match-string 2 name)))))
(when (and a (or all (equal (nth 1 a) thisline)))
@@ -3026,7 +3132,7 @@ with the prefix ARG."
(message "Convergence after %d iterations" i)
(message "Table was already stable"))
(throw 'exit t)))
- (error "No convergence after %d iterations" i))))
+ (user-error "No convergence after %d iterations" i))))
;;;###autoload
(defun org-table-recalculate-buffer-tables ()
@@ -3057,7 +3163,40 @@ with the prefix ARG."
(message "Convergence after %d iterations" (- imax i))
(throw 'exit t))
(setq checksum c1)))
- (error "No convergence after %d iterations" imax))))))
+ (user-error "No convergence after %d iterations" imax))))))
+
+(defun org-table-calc-current-TBLFM (&optional arg)
+ "Apply the #+TBLFM in the line at point to the table."
+ (interactive "P")
+ (unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line"))
+ (let ((formula (buffer-substring
+ (point-at-bol)
+ (point-at-eol)))
+ s e)
+ (save-excursion
+ ;; Insert a temporary formula at right after the table
+ (goto-char (org-table-TBLFM-begin))
+ (setq s (set-marker (make-marker) (point)))
+ (insert (concat formula "\n"))
+ (setq e (set-marker (make-marker) (point)))
+ ;; Recalculate the table
+ (beginning-of-line 0) ; move to the inserted line
+ (skip-chars-backward " \r\n\t")
+ (if (org-at-table-p)
+ (unwind-protect
+ (org-call-with-arg 'org-table-recalculate (or arg t))
+ ;; delete the formula inserted temporarily
+ (delete-region s e))))))
+
+(defun org-table-TBLFM-begin ()
+ "Find the beginning of the TBLFM lines and return its position.
+Return nil when the beginning of TBLFM line was not found."
+ (save-excursion
+ (when (progn (forward-line 1)
+ (re-search-backward
+ org-table-TBLFM-begin-regexp
+ nil t))
+ (point-at-bol 2))))
(defun org-table-expand-lhs-ranges (equations)
"Expand list of formulas.
@@ -3115,7 +3254,7 @@ borders of the table using the @< @> $< $> makers."
len
(- nmax len -1)))
(if (or (< n 1) (> n nmax))
- (error "Reference \"%s\" in expression \"%s\" points outside table"
+ (user-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)))))
@@ -3214,7 +3353,7 @@ Parameters get priority."
(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"))
+ (unless (org-at-table-p) (user-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)
@@ -3436,7 +3575,7 @@ minutes or seconds."
((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")))
+ (user-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))
@@ -3451,7 +3590,7 @@ minutes or seconds."
(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"))
+ (or (match-end n) (user-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)
@@ -3487,7 +3626,7 @@ a translation reference."
(org-number-to-letters
(max 1 (+ (org-letters-to-number ref) (if decr -1 1)))))
- (t (error "Cannot shift reference"))))))
+ (t (user-error "Cannot shift reference"))))))
(defun org-table-fedit-toggle-coordinates ()
"Toggle the display of coordinates in the referenced table."
@@ -3519,14 +3658,14 @@ With prefix ARG, apply the new formulas to the table."
(while (string-match "[ \t]*\n[ \t]*" form)
(setq form (replace-match " " t t form)))
(when (assoc var eql)
- (error "Double formulas for %s" var))
+ (user-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"))
+ (user-error "Lost table position - cannot install formulas"))
(org-table-store-formulas eql)
(move-marker pos nil)
(kill-buffer "*Edit Formulas*")
@@ -3556,14 +3695,14 @@ With prefix ARG, apply the new formulas to the table."
(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"))
+ (user-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")))
+ (user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis")))
(setq end (point))
(save-restriction
(narrow-to-region beg end)
@@ -3615,7 +3754,7 @@ With prefix ARG, apply the new formulas to the table."
((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")))
+ (t (user-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)
@@ -3682,7 +3821,7 @@ With prefix ARG, apply the new formulas to the table."
(goto-char (match-beginning 1))
(org-table-highlight-rectangle)
(message "Named column (column %s)" (cdr e)))
- (error "Column name not found")))
+ (user-error "Column name not found")))
((eq what 'column)
;; column number
(org-table-goto-column (string-to-number (substring match 1)))
@@ -3695,10 +3834,10 @@ With prefix ARG, apply the new formulas to the table."
(goto-char (match-beginning 1))
(org-table-highlight-rectangle)
(message "Local parameter."))
- (error "Parameter not found")))
+ (user-error "Parameter not found")))
(t
(cond
- ((not var) (error "No reference at point"))
+ ((not var) (user-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)))
@@ -3708,7 +3847,7 @@ With prefix ARG, apply the new formulas to the table."
((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)))))
+ (t (user-error "Undefined name $%s" var)))))
(goto-char pos)
(when (and org-show-positions
(not (memq this-command '(org-table-fedit-scroll
@@ -3734,7 +3873,7 @@ With prefix ARG, apply the new formulas to the table."
(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"))))))
+ (t (user-error "No table dataline around here"))))))
(defun org-table-fedit-line-up ()
"Move cursor one line up in the window showing the table."
@@ -3999,7 +4138,7 @@ to execute outside of tables."
(defun orgtbl-error ()
"Error when there is no default binding for a table key."
(interactive)
- (error "This key has no function outside tables"))
+ (user-error "This key has no function outside tables"))
(defun orgtbl-setup ()
"Setup orgtbl keymaps."
@@ -4151,7 +4290,7 @@ to execute outside of tables."
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)
+ (let ((case-fold-search t) (pos (point)) action)
(save-excursion
(beginning-of-line 1)
(setq action (cond
@@ -4169,17 +4308,7 @@ With prefix arg, also recompute table."
(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)))))
+ (org-table-set-constants)
(save-excursion
(beginning-of-line 1)
(skip-chars-backward " \r\n\t")
@@ -4264,31 +4393,6 @@ overwritten, and the table is not marked as requiring realignment."
(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."
@@ -4311,15 +4415,15 @@ a radio table."
(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"))
+ (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
+ (user-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"))
+ (concat "END +RECEIVE +ORGTBL +" name) nil t)
+ (user-error "Cannot find end of insertion region"))
(beginning-of-line 1)
(delete-region beg (point))))
(insert txt "\n")))
@@ -4332,7 +4436,7 @@ 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")))
+ (user-error "No table at point")))
(let* ((txt (or txt
(buffer-substring-no-properties (org-table-begin)
(org-table-end))))
@@ -4351,7 +4455,7 @@ 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"))
+ (unless (org-at-table-p) (user-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))
@@ -4359,7 +4463,7 @@ this table."
(org-table-end)))
(ntbl 0))
(unless dests (if maybe (throw 'exit nil)
- (error "Don't know how to transform this table")))
+ (user-error "Don't know how to transform this table")))
(dolist (dest dests)
(let* ((name (plist-get dest :name))
(transform (plist-get dest :transform))
@@ -4392,7 +4496,7 @@ this table."
skipcols i0))
(txt (if (fboundp transform)
(funcall transform table params)
- (error "No such transformation function %s" transform))))
+ (user-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"
@@ -4422,7 +4526,7 @@ First element has index 0, or I0 if given."
(commented (save-excursion (beginning-of-line 1)
(cond ((looking-at re1) t)
((looking-at re2) nil)
- (t (error "Not at an org table")))))
+ (t (user-error "Not at an org table")))))
(re (if commented re1 re2))
beg end)
(save-excursion
@@ -4440,7 +4544,7 @@ First element has index 0, or I0 if given."
(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))
+ (unless e (user-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)))
@@ -4474,7 +4578,8 @@ First element has index 0, or I0 if given."
fmt))
(defsubst orgtbl-apply-fmt (fmt &rest args)
- "Apply format FMT to the arguments. NIL FMTs return the first argument."
+ "Apply format FMT to arguments ARGS.
+When FMT is nil, return the first argument from ARGS."
(cond ((functionp fmt) (apply fmt args))
(fmt (apply 'format fmt args))
(args (car args))
@@ -4504,7 +4609,7 @@ First element has index 0, or I0 if given."
f)))
line)))
(push (if *orgtbl-lfmt*
- (orgtbl-apply-fmt *orgtbl-lfmt* line)
+ (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line)
(concat (orgtbl-eval-str *orgtbl-lstart*)
(mapconcat 'identity line *orgtbl-sep*)
(orgtbl-eval-str *orgtbl-lend*)))
@@ -4523,12 +4628,15 @@ First element has index 0, or I0 if given."
(orgtbl-format-line prevline))))))
;;;###autoload
-(defun orgtbl-to-generic (table params)
+(defun orgtbl-to-generic (table params &optional backend)
"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.
+A third optional argument BACKEND can be used to convert the content of
+the cells using a specific export back-end.
+
For the generic converter, some parameters are obligatory: you need to
specify either :lfmt, or all of (:lstart :lend :sep).
@@ -4599,22 +4707,31 @@ directly by `orgtbl-send-table'. See manual."
(*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*))
(*orgtbl-fmt* (plist-get params :fmt))
*orgtbl-rtn*)
-
+ ;; Convert cells content to backend BACKEND
+ (when backend
+ (setq *orgtbl-table*
+ (mapcar
+ (lambda(r)
+ (if (listp r)
+ (mapcar
+ (lambda (c)
+ (org-trim (org-export-string-as c backend t '(:with-tables t))))
+ r)
+ r))
+ *orgtbl-table*)))
;; 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 we have a heading, 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
+ ;; 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)
@@ -4632,15 +4749,12 @@ directly by `orgtbl-send-table'. See manual."
(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))
@@ -4698,7 +4812,8 @@ this function is called."
:tend "\\end{tabular}"
:lstart "" :lend " \\\\" :sep " & "
:efmt "%s\\,(%s)" :hline "\\hline")))
- (orgtbl-to-generic table (org-combine-plists params2 params))))
+ (require 'ox-latex)
+ (orgtbl-to-generic table (org-combine-plists params2 params) 'latex)))
;;;###autoload
(defun orgtbl-to-html (table params)
@@ -4714,22 +4829,14 @@ Currently this function recognizes the following parameters:
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))
+ (require 'ox-html)
+ (let ((output (org-export-string-as
+ (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t))))
+ (if (not (plist-get params :splice)) output
+ (org-trim
+ (replace-regexp-in-string
+ "\\`<table .*>\n" ""
+ (replace-regexp-in-string "</table>\n*\\'" "" output))))))
;;;###autoload
(defun orgtbl-to-texinfo (table params)
@@ -4768,7 +4875,8 @@ this function is called."
:tend "@end multitable"
:lstart "@item " :lend "" :sep " @tab "
:hlstart "@headitem ")))
- (orgtbl-to-generic table (org-combine-plists params2 params))))
+ (require 'ox-texinfo)
+ (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo)))
;;;###autoload
(defun orgtbl-to-orgtbl (table params)
@@ -4815,22 +4923,22 @@ it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
(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)"))
+ (user-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
+NAME-OR-ID may be the name of a table in the current file as set
+by a \"#+NAME:\" 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.
+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 ."
+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
@@ -4851,12 +4959,13 @@ list of the fields in the rectangle ."
(save-excursion
(goto-char (point-min))
(if (re-search-forward
- (concat "^[ \t]*#\\+tblname:[ \t]*" (regexp-quote name-or-id) "[ \t]*$")
+ (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \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))
+ (user-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)))
@@ -4868,7 +4977,7 @@ list of the fields in the rectangle ."
(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))
+ (user-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
@@ -4879,6 +4988,38 @@ list of the fields in the rectangle ."
(org-table-get-range (match-string 0 form) tbeg 1))
form)))))))))
+(defmacro org-define-lookup-function (mode)
+ (let ((mode-str (symbol-name mode))
+ (first-p (equal mode 'first))
+ (all-p (equal mode 'all)))
+ (let ((plural-str (if all-p "s" "")))
+ `(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate)
+ ,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST.
+If R-LIST is nil, return matching element%s of S-LIST.
+If PREDICATE is not nil, use it instead of `equal' to match VAL.
+Matching is done by (PREDICATE VAL S), where S is an element of S-LIST.
+This function is generated by a call to the macro `org-define-lookup-function'."
+ mode-str plural-str plural-str plural-str)
+ (let ,(let ((lvars '((p (or predicate 'equal))
+ (sl s-list)
+ (rl (or r-list s-list))
+ (ret nil))))
+ (if first-p (add-to-list 'lvars '(match-p nil)))
+ lvars)
+ (while ,(if first-p '(and (not match-p) sl) 'sl)
+ (progn
+ (if (funcall p val (car sl))
+ (progn
+ ,(if first-p '(setq match-p t))
+ (let ((rval (car rl)))
+ (setq ret ,(if all-p '(append ret (list rval)) 'rval)))))
+ (setq sl (cdr sl) rl (cdr rl))))
+ ret)))))
+
+(org-define-lookup-function first)
+(org-define-lookup-function last)
+(org-define-lookup-function all)
+
(provide 'org-table)
;; Local variables:
diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el
index 2351c4c198..db7760dcaa 100644
--- a/lisp/org/org-timer.el
+++ b/lisp/org/org-timer.el
@@ -370,6 +370,8 @@ VALUE can be `on', `off', or `pause'."
(message "%d minute(s) %d seconds left before next time out"
rmins rsecs))))
+(defvar org-clock-sound)
+
;;;###autoload
(defun org-timer-set-timer (&optional opt)
"Prompt for a duration and set a timer.
@@ -429,7 +431,7 @@ replace any running timer."
(run-with-timer
secs nil `(lambda ()
(setq org-timer-current-timer nil)
- (org-notify ,(format "%s: time out" hl) t)
+ (org-notify ,(format "%s: time out" hl) ,org-clock-sound)
(setq org-timer-timer-is-countdown nil)
(org-timer-set-mode-line 'off)
(run-hooks 'org-timer-done-hook))))
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 4fa865308e..63abb9d001 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -5,13 +5,13 @@
(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.3f"))
+ (let ((org-release "8.2.3a"))
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 "release_7.9.3f-17-g7524ef"))
+ (let ((org-git-version "release_8.2.3a"))
org-git-version))
;;;###autoload
(defvar org-odt-data-dir "/usr/share/emacs/etc/org"
diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el
index e1cc99627e..a2f29165e8 100644
--- a/lisp/org/org-w3m.el
+++ b/lisp/org/org-w3m.el
@@ -8,12 +8,12 @@
;;
;; This file is part of GNU Emacs.
;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
+;; 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.
-;; GNU Emacs is distributed in the hope that it will be useful,
+;; 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.
@@ -43,6 +43,19 @@
(require 'org)
+(defvar w3m-current-url)
+(defvar w3m-current-title)
+
+(add-hook 'org-store-link-functions 'org-w3m-store-link)
+(defun org-w3m-store-link ()
+ "Store a link to a w3m buffer."
+ (when (eq major-mode 'w3m-mode)
+ (org-store-link-props
+ :type "w3m"
+ :link w3m-current-url
+ :url (url-view-url t)
+ :description (or w3m-current-title w3m-current-url))))
+
(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
diff --git a/lisp/org/org.el b/lisp/org/org.el
index cc4c93f22e..4a74d44fe1 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -4,7 +4,7 @@
;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Maintainer: Bastien Guerry <bzg at gnu dot org>
+;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
@@ -22,7 +22,6 @@
;; 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:
;;
@@ -78,10 +77,13 @@
(require 'find-func)
(require 'format-spec)
-(load "org-loaddefs.el" t t)
+(load "org-loaddefs.el" t t t)
+
+(require 'org-macs)
+(require 'org-compat)
;; `org-outline-regexp' ought to be a defconst but is let-binding in
-;; some places -- e.g. see the macro org-with-limited-levels.
+;; 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
@@ -96,42 +98,68 @@ 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.
+ "Matches a 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)))
+(unless (boundp 'calendar-view-holidays-initially-flag)
+ (org-defvaralias 'calendar-view-holidays-initially-flag
+ 'view-calendar-holidays-initially))
+(unless (boundp 'calendar-view-diary-initially-flag)
+ (org-defvaralias 'calendar-view-diary-initially-flag
+ 'view-diary-entries-initially))
+(unless (boundp 'diary-fancy-buffer)
+ (org-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-clock-timestamps-up "org-clock" ())
-(declare-function org-clock-timestamps-down "org-clock" ())
+(declare-function org-clock-get-last-clock-out-time "org-clock" ())
+(declare-function org-clock-timestamps-up "org-clock" (&optional n))
+(declare-function org-clock-timestamps-down "org-clock" (&optional n))
(declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
(declare-function orgtbl-mode "org-table" (&optional arg))
(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
-(declare-function org-beamer-mode "org-beamer" ())
+(declare-function org-beamer-mode "ox-beamer" ())
(declare-function org-table-edit-field "org-table" (arg))
(declare-function org-table-justify-field-maybe "org-table" (&optional new))
+(declare-function org-table-set-constants "org-table" ())
+(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg))
(declare-function org-id-get-create "org-id" (&optional force))
(declare-function org-id-find-id-file "org-id" (id))
(declare-function org-tags-view "org-agenda" (&optional todo-only match))
(declare-function org-agenda-list "org-agenda" (&optional arg start-day span))
+(declare-function org-agenda-redo "org-agenda" (&optional all))
(declare-function org-table-align "org-table" ())
(declare-function org-table-paste-rectangle "org-table" ())
(declare-function org-table-maybe-eval-formula "org-table" ())
(declare-function org-table-maybe-recalculate-line "org-table" ())
+(declare-function org-element--parse-objects "org-element"
+ (beg end acc restriction))
+(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-contents "org-element" (element))
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-interpret-data "org-element"
+ (data &optional parent))
+(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-parse-buffer "org-element"
+ (&optional granularity visible-only))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-put-property "org-element"
+ (element property value))
+(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))
+(declare-function org-element-restriction "org-element" (element))
+(declare-function org-element-type "org-element" (element))
+
;; load languages based on value of `org-babel-load-languages'
(defvar org-babel-load-languages)
@@ -151,6 +179,34 @@ Stars are put in group 1 and the trimmed body in group 2.")
(intern (concat "org-babel-expand-body:" lang)))))))
org-babel-load-languages))
+;;;###autoload
+(defun org-babel-load-file (file &optional compile)
+ "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'. With prefix
+arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
+file to byte-code before it is loaded."
+ (interactive "fFile to load: \nP")
+ (require 'ob-core)
+ (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)))
+ (setq exported-file
+ (car (org-babel-tangle-file file exported-file "emacs-lisp"))))
+ (message "%s %s"
+ (if compile
+ (progn (byte-compile-file exported-file 'load)
+ "Compiled and loaded")
+ (progn (load-file exported-file) "Loaded"))
+ exported-file)))
+
(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
@@ -188,6 +244,7 @@ requirements) is loaded."
(const :tag "Ledger" ledger)
(const :tag "Lilypond" lilypond)
(const :tag "Lisp" lisp)
+ (const :tag "Makefile" makefile)
(const :tag "Maxima" maxima)
(const :tag "Matlab" matlab)
(const :tag "Mscgen" mscgen)
@@ -220,7 +277,6 @@ identifier."
:group 'org-id)
;;; Version
-(require 'org-compat)
(org-check-version)
;;;###autoload
@@ -231,11 +287,13 @@ 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-loaddefs.el")))
+ (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
+ (load-suffixes (list ".el"))
+ (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs")))
(org-trash (or
(and (fboundp 'org-release) (fboundp 'org-git-version))
- (load (concat org-dir "org-version.el")
- 'noerror 'nomessage 'nosuffix)))
+ (org-load-noerror-mustsuffix (concat org-dir "org-version"))))
+ (load-suffixes save-load-suffixes)
(org-version (org-release))
(git-version (org-git-version))
(version (format "Org-mode version %s (%s @ %s)"
@@ -301,24 +359,25 @@ When MESSAGE is non-nil, display a message with the version."
(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)
+(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail)
"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.
+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
+to add the symbol `xyz', and the package must have a call to:
+
+ \(provide 'org-xyz)
- (provide 'org-xyz)"
+For export specific modules, see also `org-export-backends'."
:group 'org
:set 'org-set-modules
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type
'(set :greedy t
(const :tag " bbdb: Links to BBDB entries" org-bbdb)
@@ -327,26 +386,20 @@ to add the symbol `xyz', and the package must have a call to
(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 " habit: Track your consistency with habits" org-habit)
(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 " mouse: Additional mouse support" org-mouse)
(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 bullets: Add overlays to headlines stars" org-bullets)
(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)
@@ -354,35 +407,137 @@ to add the symbol `xyz', and the package must have a call to
(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 eval: Include command output as text" org-eval)
(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 favtable: Lookup table of favorite references and links" org-favtable)
(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 mac-link: Grab links and url from various mac Applications" org-mac-link)
+ (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix)
(const :tag "C man: Support for links to manpages in Org-mode" org-man)
+ (const :tag "C mew: Links to Mew folders/messages" org-mew)
(const :tag "C mtags: Support for muse-like tags" org-mtags)
+ (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch)
(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 vm: Links to VM folders/messages" org-vm)
(const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes)
+ (const :tag "C wl: Links to Wanderlust folders/messages" org-wl)
(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
+(defvar org-export--registered-backends) ; From ox.el.
+(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
+(declare-function org-export-backend-name "ox" (backend))
+(defcustom org-export-backends '(ascii html icalendar latex)
+ "List of export back-ends that should be always available.
+
+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.
+
+Unlike to `org-modules', libraries in this list will not be
+loaded along with Org, but only once the export framework is
+needed.
+
+This variable needs to be set before org.el is loaded. If you
+need to make a change while Emacs is running, use the customize
+interface or run the following code, where VAL stands for the new
+value of the variable, after updating it:
+
+ \(progn
+ \(setq org-export--registered-backends
+ \(org-remove-if-not
+ \(lambda (backend)
+ \(let ((name (org-export-backend-name backend)))
+ \(or (memq name val)
+ \(catch 'parentp
+ \(dolist (b val)
+ \(and (org-export-derived-backend-p b name)
+ \(throw 'parentp t)))))))
+ org-export--registered-backends))
+ \(let ((new-list (mapcar 'org-export-backend-name
+ org-export--registered-backends)))
+ \(dolist (backend val)
+ \(cond
+ \((not (load (format \"ox-%s\" backend) t t))
+ \(message \"Problems while trying to load export back-end `%s'\"
+ backend))
+ \((not (memq backend new-list)) (push backend new-list))))
+ \(set-default 'org-export-backends new-list)))
+
+Adding a back-end to this list will also pull the back-end it
+depends on, if any."
+ :group 'org
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :initialize 'custom-initialize-set
+ :set (lambda (var val)
+ (if (not (featurep 'ox)) (set-default var val)
+ ;; Any back-end not required anymore (not present in VAL and not
+ ;; a parent of any back-end in the new value) is removed from the
+ ;; list of registered back-ends.
+ (setq org-export--registered-backends
+ (org-remove-if-not
+ (lambda (backend)
+ (let ((name (org-export-backend-name backend)))
+ (or (memq name val)
+ (catch 'parentp
+ (dolist (b val)
+ (and (org-export-derived-backend-p b name)
+ (throw 'parentp t)))))))
+ org-export--registered-backends))
+ ;; Now build NEW-LIST of both new back-ends and required
+ ;; parents.
+ (let ((new-list (mapcar 'org-export-backend-name
+ org-export--registered-backends)))
+ (dolist (backend val)
+ (cond
+ ((not (load (format "ox-%s" backend) t t))
+ (message "Problems while trying to load export back-end `%s'"
+ backend))
+ ((not (memq backend new-list)) (push backend new-list))))
+ ;; Set VAR to that list with fixed dependencies.
+ (set-default var new-list))))
+ :type '(set :greedy t
+ (const :tag " ascii Export buffer to ASCII format" ascii)
+ (const :tag " beamer Export buffer to Beamer presentation" beamer)
+ (const :tag " html Export buffer to HTML format" html)
+ (const :tag " icalendar Export buffer to iCalendar format" icalendar)
+ (const :tag " latex Export buffer to LaTeX format" latex)
+ (const :tag " man Export buffer to MAN format" man)
+ (const :tag " md Export buffer to Markdown format" md)
+ (const :tag " odt Export buffer to ODT format" odt)
+ (const :tag " org Export buffer to Org format" org)
+ (const :tag " texinfo Export buffer to Texinfo format" texinfo)
+ (const :tag "C confluence Export buffer to Confluence Wiki format" confluence)
+ (const :tag "C deck Export buffer to deck.js presentations" deck)
+ (const :tag "C freemind Export buffer to Freemind mindmap format" freemind)
+ (const :tag "C groff Export buffer to Groff format" groff)
+ (const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter)
+ (const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss)
+ (const :tag "C s5 Export buffer to s5 presentations" s5)
+ (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler)))
+
+(eval-after-load 'ox
+ '(mapc
+ (lambda (backend)
+ (condition-case nil (require (intern (format "ox-%s" backend)))
+ (error (message "Problems while trying to load export back-end `%s'"
+ backend))))
+ org-export-backends))
+
(defcustom org-support-shift-select nil
"Non-nil means make shift-cursor commands select text when possible.
@@ -498,7 +653,7 @@ the following lines anywhere in the buffer:
(const :tag "Globally (slow on startup in large files)" t)))
(defcustom org-use-sub-superscripts t
- "Non-nil means interpret \"_\" and \"^\" for export.
+ "Non-nil means interpret \"_\" and \"^\" for display.
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
@@ -511,27 +666,18 @@ sub- or superscripts.
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\"."
+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."
: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
@@ -563,6 +709,18 @@ the following lines anywhere in the buffer:
:version "24.1"
:type 'boolean)
+(defcustom org-startup-with-latex-preview nil
+ "Non-nil means preview LaTeX fragments when loading a new Org file.
+
+This can also be configured on a per-file basis by adding one of
+the followinglines anywhere in the buffer:
+ #+STARTUP: latexpreview
+ #+STARTUP: nolatexpreview"
+ :group 'org-startup
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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
@@ -602,8 +760,7 @@ it work for ESC."
:group 'org-startup
:type 'boolean)
-(if (fboundp 'defvaralias)
- (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys))
+(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
(defcustom org-disputed-keys
'(([(shift up)] . [(meta p)])
@@ -695,6 +852,14 @@ Changes become only effective after restarting Emacs."
:group 'org-keywords
:type 'string)
+(defcustom org-closed-keep-when-no-todo nil
+ "Remove CLOSED: time-stamp when switching back to a non-todo state?"
+ :group 'org-todo
+ :group 'org-keywords
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\("
org-scheduled-string "\\|"
org-deadline-string "\\|"
@@ -786,7 +951,7 @@ 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))
+(defcustom org-show-siblings '((default . nil) (isearch t) (bookmark-jump 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
@@ -800,7 +965,9 @@ 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)
+ :type org-context-choice
+ :version "24.4"
+ :package-version '(Org . "8.0"))
(defcustom org-show-entry-below '((default . nil))
"Non-nil means show the entry below a headline when revealing a location.
@@ -865,6 +1032,21 @@ commands in the Help buffer using the `?' speed command."
(function)
(sexp))))))
+(defcustom org-bookmark-names-plist
+ '(:last-capture "org-capture-last-stored"
+ :last-refile "org-refile-last-stored"
+ :last-capture-marker "org-capture-last-stored-marker")
+ "Names for bookmarks automatically set by some Org commands.
+This can provide strings as names for a number of bookmakrs Org sets
+automatically. The following keys are currently implemented:
+ :last-capture
+ :last-capture-marker
+ :last-refile
+When a key does not show up in the property list, the corresponding bookmark
+is not set."
+ :group 'org-structure
+ :type 'plist)
+
(defgroup org-cycle nil
"Options concerning visibility cycling in Org-mode."
:tag "Org Cycle"
@@ -957,8 +1139,7 @@ visibility is cycled."
(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)
- ))
+ (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.
@@ -990,6 +1171,7 @@ the values `folded', `children', or `subtree'."
(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
org-cycle-hide-drawers
+ org-cycle-hide-inline-tasks
org-cycle-show-empty-lines
org-optimize-window-after-visibility-change)
"Hook that is run after `org-cycle' has changed the buffer visibility.
@@ -1083,8 +1265,7 @@ This may also be a cons cell where the behavior for `C-a' and
(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))
+(org-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.
@@ -1111,6 +1292,11 @@ OK to kill that hidden subtree. When nil, kill without remorse."
(const :tag "Protect hidden subtrees with a security query" t)
(const :tag "Never kill a hidden subtree with C-k" error)))
+(defcustom org-special-ctrl-o t
+ "Non-nil means, make `C-o' insert a row in tables."
+ :group 'org-edit-structure
+ :type 'boolean)
+
(defcustom org-catch-invisible-edits nil
"Check if in invisible region before inserting or deleting a character.
Valid values are:
@@ -1180,9 +1366,8 @@ default the value to be used for all contexts not explicitly
(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."
+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)
@@ -1194,9 +1379,9 @@ 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."
+For plain lists, if `org-list-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)
@@ -1430,7 +1615,7 @@ 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)
+ :type '(choice (const nil) (function)))
(defgroup org-link-store nil
"Options concerning storing links in Org-mode."
@@ -1519,7 +1704,7 @@ 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)
+ :type '(choice (const nil) (function)))
(defcustom org-follow-link-hook nil
"Hook that is run after a link has been followed."
@@ -1535,7 +1720,8 @@ implementation is bad."
:type 'boolean)
(defcustom org-return-follows-link nil
- "Non-nil means on links RET will follow the link."
+ "Non-nil means on links RET will follow the link.
+In tables, the special behavior of RET has precedence."
:group 'org-link-follow
:type 'boolean)
@@ -1600,6 +1786,11 @@ another window."
(const vm-visit-folder)
(const vm-visit-folder-other-window)
(const vm-visit-folder-other-frame)))
+ (cons (const vm-imap)
+ (choice
+ (const vm-visit-imap-folder)
+ (const vm-visit-imap-folder-other-window)
+ (const vm-visit-imap-folder-other-frame)))
(cons (const gnus)
(choice
(const gnus)
@@ -1746,12 +1937,10 @@ The system \"open\" is used for most files.
See `org-file-apps'.")
(defcustom org-file-apps
- '(
- (auto-mode . emacs)
+ '((auto-mode . emacs)
("\\.mm\\'" . default)
("\\.x?html?\\'" . default)
- ("\\.pdf\\'" . 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
@@ -1865,16 +2054,14 @@ following situations:
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."
+Used as a fall back file for 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)
@@ -1904,7 +2091,6 @@ outline-path-completion Headlines in the current buffer are offered via
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
@@ -2000,7 +2186,9 @@ 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)
+ :type '(choice
+ (const nil)
+ (function)))
(defcustom org-refile-use-cache nil
"Non-nil means cache refile targets to speed up the process.
@@ -2157,7 +2345,12 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
(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-tag-alist-for-agenda nil
+ "Alist of all tags from all agenda files.")
+(defvar org-tag-groups-alist-for-agenda nil
+ "Alist of all groups tags from all current agenda files.")
+(defvar org-tag-groups-alist nil)
+(make-variable-buffer-local 'org-tag-groups-alist)
(defvar org-agenda-contributing-files nil)
(defvar org-not-done-keywords nil)
(make-variable-buffer-local 'org-not-done-keywords)
@@ -2491,6 +2684,11 @@ also set this to a string to define the drawer of your choice.
A value of t is also allowed, representing \"LOGBOOK\".
+A value of t or nil can also be set with on a per-file-basis with
+
+ #+STARTUP: logdrawer
+ #+STARTUP: nologdrawer
+
If this variable is set, `org-log-state-notes-insert-after-drawers'
will be ignored.
@@ -2503,8 +2701,7 @@ a subtree."
(const :tag "LOGBOOK" t)
(string :tag "Other")))
-(if (fboundp 'defvaralias)
- (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer))
+(org-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.
@@ -2532,7 +2729,12 @@ set."
(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."
+When nil, the state change notes will be ordered according to time.
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: logstatesreversed
+ #+STARTUP: nologstatesreversed"
:group 'org-todo
:group 'org-progress
:type 'boolean)
@@ -2629,7 +2831,9 @@ 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)
+ :type '(choice
+ (const nil)
+ (function)))
(defgroup org-time nil
"Options concerning time stamps and deadlines in Org-mode."
@@ -2705,26 +2909,137 @@ commands, if custom time display is turned on at the time of export."
(concat "[" (substring f 1 -1) "]")
f)))
-(defcustom org-time-clocksum-format "%d:%02d"
+(defcustom org-time-clocksum-format
+ '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t)
"The format string used when creating CLOCKSUM lines.
-This is also used when org-mode generates a time duration."
+This is also used when Org mode generates a time duration.
+
+The value can be a single format string containing two
+%-sequences, which will be filled with the number of hours and
+minutes in that order.
+
+Alternatively, the value can be a plist associating any of the
+keys :years, :months, :weeks, :days, :hours or :minutes with
+format strings. The time duration is formatted using only the
+time components that are needed and concatenating the results.
+If a time unit in absent, it falls back to the next smallest
+unit.
+
+The keys :require-years, :require-months, :require-days,
+:require-weeks, :require-hours, :require-minutes are also
+meaningful. A non-nil value for these keys indicates that the
+corresponding time component should always be included, even if
+its value is 0.
+
+
+For example,
+
+ \(:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\"
+ :require-minutes t)
+
+means durations longer than a day will be expressed in days,
+hours and minutes, and durations less than a day will always be
+expressed in hours and minutes (even for durations less than an
+hour).
+
+The value
+
+ \(:days \"%dd\" :minutes \"%dm\")
+
+means durations longer than a day will be expressed in days and
+minutes, and durations less than a day will be expressed entirely
+in minutes (even for durations longer than an hour)."
:group 'org-time
- :type 'string)
+ :group 'org-clock
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice (string :tag "Format string")
+ (set :tag "Plist"
+ (group :inline t (const :tag "Years" :years)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show years" :require-years)
+ (const t))
+ (group :inline t (const :tag "Months" :months)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show months" :require-months)
+ (const t))
+ (group :inline t (const :tag "Weeks" :weeks)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show weeks" :require-weeks)
+ (const t))
+ (group :inline t (const :tag "Days" :days)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show days" :require-days)
+ (const t))
+ (group :inline t (const :tag "Hours" :hours)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show hours" :require-hours)
+ (const t))
+ (group :inline t (const :tag "Minutes" :minutes)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show minutes" :require-minutes)
+ (const t)))))
(defcustom org-time-clocksum-use-fractional nil
- "If non-nil, \\[org-clock-display] uses fractional times.
-org-mode generates a time duration."
+ "When non-nil, \\[org-clock-display] uses fractional times.
+See `org-time-clocksum-format' for more on time clock formats."
+ :group 'org-time
+ :group 'org-clock
+ :version "24.3"
+ :type 'boolean)
+
+(defcustom org-time-clocksum-use-effort-durations nil
+ "When non-nil, \\[org-clock-display] uses effort durations.
+E.g. by default, one day is considered to be a 8 hours effort,
+so a task that has been clocked for 16 hours will be displayed
+as during 2 days in the clock display or in the clocktable.
+
+See `org-effort-durations' on how to set effort durations
+and `org-time-clocksum-format' for more on time clock formats."
:group 'org-time
+ :group 'org-clock
+ :version "24.4"
+ :package-version '(Org . "8.0")
: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."
+ "The format string used when creating CLOCKSUM lines,
+or when Org mode generates a time duration, if
+`org-time-clocksum-use-fractional' is enabled.
+
+The value can be a single format string containing one
+%-sequence, which will be filled with the number of hours as
+a float.
+
+Alternatively, the value can be a plist associating any of the
+keys :years, :months, :weeks, :days, :hours or :minutes with
+a format string. The time duration is formatted using the
+largest time unit which gives a non-zero integer part. If all
+specified formats have zero integer part, the smallest time unit
+is used."
:group 'org-time
- :type 'string)
+ :type '(choice (string :tag "Format string")
+ (set (group :inline t (const :tag "Years" :years)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Months" :months)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Weeks" :weeks)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Days" :days)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Hours" :hours)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Minutes" :minutes)
+ (string :tag "Format string")))))
(defcustom org-deadline-warning-days 14
- "No. of days before expiration during which a deadline becomes active.
+ "Number 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.
@@ -2734,6 +3049,21 @@ Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
:type 'integer)
+(defcustom org-scheduled-delay-days 0
+ "Number of days before a scheduled item becomes active.
+This variable governs the display in sparse trees and in the agenda.
+The default value (i.e. 0) means: don't delay scheduled item.
+When negative, it means use this number (the absolute value of it)
+even if a scheduled item has a different individual delay time
+specified.
+
+Custom commands can set this variable in the options section."
+ :group 'org-time
+ :group 'org-agenda-daily/weekly
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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:
@@ -2821,14 +3151,19 @@ 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))
+(org-defvaralias 'org-popup-calendar-for-date-prompt
+ 'org-read-date-popup-calendar)
+(make-obsolete-variable
+ 'org-read-date-minibuffer-setup-hook
+ "Set `org-read-date-minibuffer-local-map' instead." "24.4")
(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."
+Add key definitions to `minibuffer-local-map', which will be a
+temporary copy.
+
+WARNING: This option is obsolete, you should use
+`org-read-date-minibuffer-local-map' to set up keys."
:group 'org-time
:type 'hook)
@@ -2856,6 +3191,15 @@ For example, if `org-extend-today-until' is 8, and it's 4am, then the
:version "24.1"
:type 'boolean)
+(defcustom org-use-last-clock-out-time-as-effective-time nil
+ "When non-nil, use the last clock out time for `org-todo'.
+Note that this option has precedence over the combined use of
+`org-use-effective-time' and `org-extend-today-until'."
+ :group 'org-time
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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."
@@ -2890,6 +3234,8 @@ See the manual for details."
(list :tag "Start radio group"
(const :startgroup)
(option (string :tag "Group description")))
+ (list :tag "Group tags delimiter"
+ (const :grouptags))
(list :tag "End radio group"
(const :endgroup)
(option (string :tag "Group description")))
@@ -2912,6 +3258,7 @@ To disable these tags on a per-file basis, insert anywhere in the file:
(cons (string :tag "Tag name")
(character :tag "Access char"))
(const :tag "Start radio group" (:startgroup))
+ (const :tag "Group tags delimiter" (:grouptags))
(const :tag "End radio group" (:endgroup))
(const :tag "New line" (:newline)))))
@@ -2949,7 +3296,7 @@ automatically if necessary."
:type '(choice
(const :tag "Always" t)
(const :tag "Never" nil)
- (const :tag "When selection characters are configured" 'auto)))
+ (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.
@@ -3094,7 +3441,7 @@ and the clock summary:
(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))))))"
+ (org-minutes-to-clocksum-string (- effort clocksum))))))"
:group 'org-properties
:version "24.1"
:type '(alist :key-type (string :tag "Property")
@@ -3170,7 +3517,7 @@ 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)
+ :type '(choice (const nil) (function)))
(defcustom org-effort-property "Effort"
"The property that is being used to keep track of effort estimates.
@@ -3263,23 +3610,22 @@ regular expression will be included."
(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
+These files will be searched 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
+then 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))
+(org-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'.
@@ -3340,8 +3686,10 @@ points to a file, `org-agenda-diary-entry' will be used instead."
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.
+ `auto' means use the foreground from the text face.
:background the background color, or \"Transparent\".
`default' means use the background of the default face.
+ `auto' means use the background from the text 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.
@@ -3408,9 +3756,10 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
(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."
+ "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)
@@ -3430,11 +3779,9 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
(defcustom org-format-latex-header "\\documentclass{article}
\\usepackage[usenames]{color}
-\\usepackage{amsmath}
-\\usepackage[mathscr]{eucal}
-\\pagestyle{empty} % do not remove
\[PACKAGES]
\[DEFAULT-PACKAGES]
+\\pagestyle{empty} % do not remove
% The settings below are copied from fullpage.sty
\\setlength{\\textwidth}{\\paperwidth}
\\addtolength{\\textwidth}{-3cm}
@@ -3451,14 +3798,12 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
"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."
+`org-latex-default-packages-alist' and `org-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)
@@ -3468,7 +3813,6 @@ will be appended."
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))
@@ -3476,10 +3820,7 @@ will be appended."
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
+(defcustom org-latex-default-packages-alist
'(("AUTO" "inputenc" t)
("T1" "fontenc" t)
("" "fixltx2e" nil)
@@ -3487,36 +3828,44 @@ will be appended."
("" "longtable" nil)
("" "float" nil)
("" "wrapfig" nil)
- ("" "soul" t)
+ ("" "rotating" nil)
+ ("normalem" "ulem" t)
+ ("" "amsmath" t)
("" "textcomp" t)
("" "marvosym" t)
("" "wasysym" t)
- ("" "latexsym" t)
("" "amssymb" t)
("" "hyperref" nil)
- "\\tolerance=1000"
- )
+ "\\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.
+
+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.
+- fixltx2e: Important patches of LaTeX itself
- graphicx: for including images
+- longtable: For multipage tables
- float, wrapfig: for figure placement
-- longtable: for long tables
+- rotating: for sideways figures and tables
+- ulem: for underline and strike-through
+- amsmath: for subscript and superscript and math environments
+- textcomp, marvosymb, wasysym, amssymb: 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 their symbols.
- 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."
+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 non-LaTeX output."
+ :group 'org-latex
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
@@ -3529,17 +3878,25 @@ compiling LaTeX snippets into images for inclusion into HTML."
(boolean :tag "Snippet"))
(string :tag "A line of LaTeX"))))
-(defcustom org-export-latex-packages-alist nil
+(defcustom org-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.
+
+These will be inserted after `org-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
+non-LaTeX output.
+
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'."
+
+ - you want in every file
+ - do not conflict with the setup in `org-format-latex-header'.
+ - do not conflict with the default packages in
+ `org-latex-default-packages-alist'."
+ :group 'org-latex
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
@@ -3551,7 +3908,6 @@ Make sure that you only list packages here which:
(boolean :tag "Snippet"))
(string :tag "A line of LaTeX"))))
-
(defgroup org-appearance nil
"Settings for Org-mode appearance."
:tag "Org Appearance"
@@ -3622,10 +3978,22 @@ 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."
+(defcustom org-highlight-latex-and-related nil
+ "Non-nil means highlight LaTeX related syntax in the buffer.
+When non nil, the value should be a list containing any of the
+following symbols:
+ `latex' Highlight LaTeX snippets and environments.
+ `script' Highlight subscript and superscript.
+ `entities' Highlight entities."
:group 'org-appearance
- :type 'boolean)
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "No highlighting" nil)
+ (set :greedy t :tag "Highlight"
+ (const :tag "LaTeX snippets and environments" latex)
+ (const :tag "Subscript and superscript" script)
+ (const :tag "Entities" entities))))
(defcustom org-hide-emphasis-markers nil
"Non-nil mean font-lock should hide the emphasis marker characters."
@@ -3674,7 +4042,7 @@ After a match, the match groups contain these elements:
(body1 (concat body "*?"))
(markers (mapconcat 'car org-emphasis-alist ""))
(vmarkers (mapconcat
- (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) ""))
+ (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) ""))
org-emphasis-alist "")))
;; make sure special characters appear at the right position in the class
(if (string-match "\\^" markers)
@@ -3714,7 +4082,10 @@ After a match, the match groups contain these elements:
"\\3\\)"
"\\([" post "]\\|$\\)")))))
-(defcustom org-emphasis-regexp-components
+;; This used to be a defcustom (Org <8.0) but allowing the users to
+;; set this option proved cumbersome. See this message/thread:
+;; http://article.gmane.org/gmane.emacs.orgmode/68681
+(defvar 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
@@ -3730,48 +4101,36 @@ 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"))))
+You need to reload Org or to restart Emacs after customizing this.")
(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."
+ `(("*" bold)
+ ("/" italic)
+ ("_" underline)
+ ("=" org-code verbatim)
+ ("~" org-verbatim verbatim)
+ ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t))))
+ "Alist of characters and faces to emphasize text.
+Text starting and ending with a special character will be emphasized,
+for example *bold*, _underlined_ and /italic/. This variable sets the
+marker characters and the face to be used by font-lock for highlighting
+in Org-mode Emacs buffers.
+
+You need to reload Org or to restart Emacs after customizing this."
:group 'org-appearance
:set 'org-set-emph-re
+ :version "24.4"
+ :package-version '(Org . "8.0")
: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")
+ '("src" "example" "latex" "ascii" "html" "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.")
@@ -3838,7 +4197,7 @@ Normal means, no org-mode-specific context."
(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))
+ (extra txt &optional level 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))
@@ -3856,16 +4215,12 @@ Normal means, no org-mode-specific context."
(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
@@ -3893,6 +4248,9 @@ This works for both table types.")
(org-autoload "org-table"
'(org-table-begin org-table-blank-field org-table-end)))
+(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: "
+ "Detect a #+TBLFM line.")
+
;;;###autoload
(defun turn-on-orgtbl ()
"Unconditionally turn on `orgtbl-mode'."
@@ -3951,7 +4309,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(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
@@ -3971,12 +4328,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(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")
-
;; Declare and autoload functions from org-agenda.el
(eval-and-compile
@@ -3987,6 +4338,15 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(declare-function org-clock-update-mode-line "org-clock" ())
(declare-function org-resolve-clocks "org-clock"
(&optional also-non-dangling-p prompt last-valid))
+
+(defun org-at-TBLFM-p (&optional pos)
+ "Return t when point (or POS) is in #+TBLFM line."
+ (save-excursion
+ (let ((pos pos)))
+ (goto-char (or pos (point)))
+ (beginning-of-line 1)
+ (looking-at org-TBLFM-regexp)))
+
(defvar org-clock-start-time)
(defvar org-clock-marker (make-marker)
"Marker recording the last clock-in.")
@@ -3995,8 +4355,8 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(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."
+ "Return the buffer where the clock is currently running.
+Return nil if no clock is running."
(marker-buffer org-clock-marker))
(eval-and-compile
@@ -4150,12 +4510,13 @@ Otherwise, these types are allowed:
inactive: only inactive timestamps (<...)
scheduled: only scheduled timestamps
deadline: only deadline timestamps"
- :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline)
+ :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))
+ (const :tag "Only deadline timestamps" deadline)
+ (const :tag "Only closed timestamps" closed))
:version "24.3"
:group 'org-sparse-trees)
@@ -4274,6 +4635,9 @@ Also put tags into group 4 if tags are present.")
(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-time-hour-regexp nil
+ "Matches the DEADLINE keyword together with a time-and-hour stamp.")
+(make-variable-buffer-local 'org-deadline-time-hour-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)
@@ -4283,6 +4647,9 @@ Also put tags into group 4 if tags are present.")
(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-scheduled-time-hour-regexp nil
+ "Matches the SCHEDULED keyword together with a time-and-hour stamp.")
+(make-variable-buffer-local 'org-scheduled-time-hour-regexp)
(defvar org-closed-time-regexp nil
"Matches the CLOSED keyword together with a time stamp.")
(make-variable-buffer-local 'org-closed-time-regexp)
@@ -4357,6 +4724,8 @@ After a match, the following groups carry important information:
("noalign" org-startup-align-all-tables nil)
("inlineimages" org-startup-with-inline-images t)
("noinlineimages" org-startup-with-inline-images nil)
+ ("latexpreview" org-startup-with-latex-preview t)
+ ("nolatexpreview" org-startup-with-latex-preview nil)
("customtime" org-display-custom-times t)
("logdone" org-log-done time)
("lognotedone" org-log-done note)
@@ -4365,6 +4734,10 @@ After a match, the following groups carry important information:
("nolognoteclock-out" org-log-note-clock-out nil)
("logrepeat" org-log-repeat state)
("lognoterepeat" org-log-repeat note)
+ ("logdrawer" org-log-into-drawer t)
+ ("nologdrawer" org-log-into-drawer nil)
+ ("logstatesreversed" org-log-states-order-reversed t)
+ ("nologstatesreversed" org-log-states-order-reversed nil)
("nologrepeat" org-log-repeat nil)
("logreschedule" org-log-reschedule time)
("lognotereschedule" org-log-reschedule note)
@@ -4413,19 +4786,119 @@ means to push this value onto the list in the variable.")
"Regular expression for hiding blocks.")
(defconst org-heading-keyword-regexp-format
"^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Printf format for a regexp matching an headline with some keyword.
+ "Printf format for a regexp matching a 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.
+ "Printf format for a regexp matching a 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.")
+(defcustom org-group-tags t
+ "When non-nil (the default), use group tags.
+This can be turned on/off through `org-toggle-tags-groups'."
+ :group 'org-tags
+ :group 'org-startup
+ :type 'boolean)
+
+(defun org-toggle-tags-groups ()
+ "Toggle support for group tags.
+Support for group tags is controlled by the option
+`org-group-tags', which is non-nil by default."
+ (interactive)
+ (setq org-group-tags (not org-group-tags))
+ (cond ((and (derived-mode-p 'org-agenda-mode)
+ org-group-tags)
+ (org-agenda-redo))
+ ((derived-mode-p 'org-mode)
+ (let ((org-inhibit-startup t)) (org-mode))))
+ (message "Groups tags support has been turned %s"
+ (if org-group-tags "on" "off")))
+
+(defun org-set-regexps-and-options-for-tags ()
+ "Precompute variables used for tags."
+ (when (derived-mode-p 'org-mode)
+ (org-set-local 'org-file-tags nil)
+ (let ((re (org-make-options-regexp '("FILETAGS" "TAGS")))
+ (splitre "[ \t]+")
+ (start 0)
+ tags ftags key value)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (setq key (upcase (org-match-string-no-properties 1))
+ value (org-match-string-no-properties 2))
+ (if (stringp value) (setq value (org-trim value)))
+ (cond
+ ((equal key "TAGS")
+ (setq tags (append tags (if tags '("\\n") nil)
+ (org-split-string value splitre))))
+ ((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)))))))))))
+ ;; Process the file tags.
+ (and ftags (org-set-local 'org-file-tags
+ (mapcar 'org-add-prop-inherited ftags)))
+ (org-set-local 'org-tag-groups-alist nil)
+ ;; Process the tags.
+ (when (and (not tags) org-tag-alist)
+ (setq tags
+ (mapcar
+ (lambda (tg) (cond ((eq (car tg) :startgroup) "{")
+ ((eq (car tg) :endgroup) "}")
+ ((eq (car tg) :grouptags) ":")
+ ((eq (car tg) :newline) "\n")
+ (t (concat (car tg)
+ (if (characterp (cdr tg))
+ (format "(%s)" (char-to-string (cdr tg))) "")))))
+ org-tag-alist)))
+ (let (e tgs g)
+ (while (setq e (pop tags))
+ (cond
+ ((equal e "{")
+ (progn (push '(:startgroup) tgs)
+ (when (equal (nth 1 tags) ":")
+ (push (list (replace-regexp-in-string
+ "(.+)$" "" (nth 0 tags)))
+ org-tag-groups-alist)
+ (setq g 0))))
+ ((equal e ":") (push '(:grouptags) tgs))
+ ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil)))
+ ((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)
+ (if (and g (> g 0))
+ (setcar org-tag-groups-alist
+ (append (car org-tag-groups-alist)
+ (list (match-string 1 e)))))
+ (if g (setq g (1+ g))))
+ (t (push (list e) tgs)
+ (if (and g (> g 0))
+ (setcar org-tag-groups-alist
+ (append (car org-tag-groups-alist) (list e))))
+ (if g (setq g (1+ g))))))
+ (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)))
+ ;; Return a list with tag variables
+ (list org-file-tags org-tag-alist org-tag-groups-alist)))))
+
+(defvar org-ota nil)
(defun org-set-regexps-and-options ()
- "Precompute regular expressions for current buffer."
+ "Precompute regular expressions used in the current buffer."
(when (derived-mode-p 'org-mode)
(org-set-local 'org-todo-kwd-alist nil)
(org-set-local 'org-todo-key-alist nil)
@@ -4436,27 +4909,43 @@ but the stars and the body are.")
(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")
+ '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE"
+ "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS"
+ "SETUPFILE" "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))
+ kwds kws0 kwsa key log value cat arch const links hw dws
+ tail sep kws1 prio props drawers 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)))
+ (while
+ (or (and
+ ext-setup-or-nil
+ (not org-ota)
+ (let (ret)
+ (with-temp-buffer
+ (insert ext-setup-or-nil)
+ (let ((major-mode 'org-mode) org-ota)
+ (setq ret (save-match-data
+ (org-set-regexps-and-options-for-tags)))))
+ ;; Append setupfile tags to existing tags
+ (setq org-ota t)
+ (setq org-file-tags
+ (delq nil (append org-file-tags (nth 0 ret)))
+ org-tag-alist
+ (delq nil (append org-tag-alist (nth 1 ret)))
+ org-tag-groups-alist
+ (delq nil (append org-tag-groups-alist (nth 2 ret))))))
+ (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)))
@@ -4471,9 +4960,6 @@ but the stars and the body are.")
;; 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")
@@ -4488,18 +4974,10 @@ but the stars and the body are.")
(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))))
+ (org-table-set-constants))
((equal key "STARTUP")
(let ((opts (org-split-string value splitre))
l var val)
@@ -4516,12 +4994,12 @@ but the stars and the body are.")
(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")
+ ((and (equal key "SETUPFILE")
+ ;; Prevent checking in Gnus messages
+ (not buffer-read-only))
(setq setup-contents (org-file-contents
(expand-file-name
(org-remove-double-quotes value))
@@ -4553,8 +5031,6 @@ but the stars and the body are.")
(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)))
@@ -4605,33 +5081,6 @@ but the stars and the body are.")
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.
@@ -4688,12 +5137,18 @@ but the stars and the body are.")
org-deadline-regexp (concat "\\<" org-deadline-string)
org-deadline-time-regexp
(concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
+ org-deadline-time-hour-regexp
+ (concat "\\<" org-deadline-string
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
org-deadline-line-regexp
(concat "\\<\\(" org-deadline-string "\\).*")
org-scheduled-regexp
(concat "\\<" org-scheduled-string)
org-scheduled-time-regexp
(concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
+ org-scheduled-time-hour-regexp
+ (concat "\\<" org-scheduled-string
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
org-closed-time-regexp
(concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
org-keyword-time-regexp
@@ -4717,20 +5172,16 @@ but the stars and the body are.")
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))))
+ org-clock-string org-closed-string)))
+ (setq org-ota nil)
+ (org-compute-latex-and-related-regexp))))
(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)
- "")
+ (message "Cannot read file \"%s\"" file)
(error "Cannot read file \"%s\"" file))
(with-temp-buffer
(insert-file-contents file)
@@ -4763,7 +5214,7 @@ This will extract info from a string like \"WAIT(w@/!)\"."
Respect keys that are already there."
(let (new e (alt ?0))
(while (setq e (pop alist))
- (if (or (memq (car e) '(:newline :endgroup :startgroup))
+ (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup))
(cdr e)) ;; Key already assigned.
(push e new)
(let ((clist (string-to-list (downcase (car e))))
@@ -4834,7 +5285,7 @@ This variable is set by `org-before-change-function'.
(require 'easymenu)
(require 'overlay)
-(require 'org-macs)
+;; (require 'org-macs) moved higher up in the file before it is first used
(require 'org-entities)
;; (require 'org-compat) moved higher up in the file before it is first used
(require 'org-faces)
@@ -4842,15 +5293,10 @@ This variable is set by `org-before-change-function'.
(require 'org-pcomplete)
(require 'org-src)
(require 'org-footnote)
+(require 'org-macro)
;; 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"
@@ -4910,13 +5356,17 @@ The following commands are available:
org-ellipsis)))
(if (stringp org-ellipsis) org-ellipsis "..."))))
(setq buffer-display-table org-display-table))
+ (org-set-regexps-and-options-for-tags)
(org-set-regexps-and-options)
+ (org-set-font-lock-defaults)
(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 a few syntax entries
(modify-syntax-entry ?@ "w")
+ (modify-syntax-entry ?\" "\"")
(if org-startup-truncated (setq truncate-lines t))
(when org-startup-indented (require 'org-indent) (org-indent-mode 1))
(org-set-local 'font-lock-unfontify-region-function
@@ -4927,18 +5377,20 @@ The following commands are available:
'local)
;; Check for running clock before killing a buffer
(org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
+ ;; Initialize macros templates.
+ (org-macro-initialize-templates)
+ ;; Initialize radio targets.
+ (org-update-radio-target-regexp)
;; 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)))
+ (org-set-local 'beginning-of-defun-function 'org-backward-element)
+ (org-set-local 'end-of-defun-function 'org-forward-element)
;; 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
@@ -4994,18 +5446,32 @@ The following commands are available:
(= (point-min) (point-max)))
(insert "# -*- mode: org -*-\n\n"))
(unless org-inhibit-startup
- (and org-startup-with-beamer-mode (org-beamer-mode))
- (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))
- (unless org-inhibit-startup-visibility-stuff
- (org-set-startup-visibility)))
+ (org-unmodified
+ (and org-startup-with-beamer-mode (org-beamer-mode))
+ (when org-startup-align-all-tables
+ (org-table-map-tables 'org-table-align 'quietly))
+ (when org-startup-with-inline-images
+ (org-display-inline-images))
+ (when org-startup-with-latex-preview
+ (org-preview-latex-fragment))
+ (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)))
+;; Update `customize-package-emacs-version-alist'
+(add-to-list 'customize-package-emacs-version-alist
+ '(Org ("6.21b" . "23.1") ("6.33x" . "23.2")
+ ("7.8.11" . "24.1") ("7.9.4" . "24.3")
+ ("8.0" . "24.4")))
+
+(defvar org-mode-transpose-word-syntax-table
+ (let ((st (make-syntax-table)))
+ (mapc (lambda(c) (modify-syntax-entry
+ (string-to-char (car c)) "w p" st))
+ org-emphasis-alist)
+ st))
+
(when (fboundp 'abbrev-table-put)
(abbrev-table-put org-mode-abbrev-table
:parents (list text-mode-abbrev-table)))
@@ -5029,15 +5495,23 @@ The following commands are available:
(list (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-current-time (&optional rounding-minutes past)
+ "Current time, possibly rounded to ROUNDING-MINUTES.
+When ROUNDING-MINUTES is not an integer, fall back on the car of
+`org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure
+the rounding returns a past time."
+ (let ((r (or (and (integerp rounding-minutes) rounding-minutes)
+ (car org-time-stamp-rounding-minutes)))
+ (time (decode-time)) res)
+ (if (< r 1)
+ (current-time)
+ (setq res
+ (apply 'encode-time
+ (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
+ (nthcdr 2 time))))
+ (if (and past (< (org-float-time (time-subtract (current-time) res)) 0))
+ (seconds-to-time (- (org-float-time res) (* r 60)))
+ res))))
(defun org-today ()
"Return today date, considering `org-extend-today-until'."
@@ -5088,11 +5562,8 @@ Here is what the match groups contain after a match:
(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)
+(defconst org-match-sexp-depth 3
+ "Number of stacked braces for sub/superscript matching.")
(defun org-create-multibrace-regexp (left right n)
"Create a regular expression which will match a balanced sexp.
@@ -5114,7 +5585,7 @@ stacked delimiters is N. Escaping delimiters is not possible."
(defvar org-match-substring-regexp
(concat
- "\\([^\\]\\|^\\)\\([_^]\\)\\("
+ "\\(\\S-\\)\\([_^]\\)\\("
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\|"
"\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
@@ -5124,7 +5595,7 @@ stacked delimiters is N. Escaping delimiters is not possible."
(defvar org-match-substring-with-braces-regexp
(concat
- "\\([^\\]\\|^\\)\\([_^]\\)\\("
+ "\\(\\S-\\)\\([_^]\\)\\("
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\)")
"The regular expression matching a sub- or superscript, forcing braces.")
@@ -5231,7 +5702,7 @@ The time stamps may be either active or inactive.")
(font-lock-prepend-text-property (match-beginning 2) (match-end 2)
'face
(nth 1 a))
- (and (nth 4 a)
+ (and (nth 2 a)
(org-remove-flyspell-overlays-in
(match-beginning 0) (match-end 0)))
(add-text-properties (match-beginning 2) (match-end 2)
@@ -5249,36 +5720,27 @@ The time stamps may be either active or inactive.")
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."
+CHAR should be the marker character. If it is a space, it 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)
+ (let ((erc org-emphasis-regexp-components)
(prompt "")
- (string "") beg end move tag c s)
+ (string "") beg end move 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))
+ (message "Emphasis marker or tag: [%s]"
+ (mapconcat (lambda(e) (car e)) org-emphasis-alist ""))
(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))
+ (user-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))
@@ -5305,17 +5767,19 @@ will be prompted for."
(defun org-activate-plain-links (limit)
"Run through the buffer and add overlays to links."
- (let (f)
+ (let (f hl)
(when (and (re-search-forward (concat org-plain-link-re) limit t)
(not (org-in-src-block-p)))
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(setq f (get-text-property (match-beginning 0) 'face))
- (unless (or (org-in-src-block-p)
- (eq f 'org-tag)
- (and (listp f) (memq 'org-tag f)))
+ (setq hl (org-match-string-no-properties 0))
+ (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
+ 'htmlize-link `(:uri ,hl)
'keymap org-mouse-map))
(org-rear-nonsticky-at (match-end 0)))
t)))
@@ -5349,7 +5813,7 @@ by a #."
(error (message "org-mode fontification error"))))
(defun org-fontify-meta-lines-and-blocks-1 (limit)
- "Fontify #+ lines and blocks, in the correct ways."
+ "Fontify #+ lines and blocks."
(let ((case-fold-search t))
(if (re-search-forward
"^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
@@ -5363,7 +5827,7 @@ by a #."
(dc3 (downcase (match-string 3)))
end end1 quoting block-type ovl)
(cond
- ((member dc1 '("+html:" "+ascii:" "+latex:" "+docbook:"))
+ ((member dc1 '("+html:" "+ascii:" "+latex:"))
;; 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)
@@ -5482,17 +5946,16 @@ by a #."
"Run through the buffer and add overlays to bracketed links."
(if (and (re-search-forward org-bracket-link-regexp limit t)
(not (org-in-src-block-p)))
- (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.
+ (let* ((hl (org-match-string-no-properties 1))
+ (help (concat "LINK: " (save-match-data (org-link-unescape hl))))
(ip (org-maybe-intangible
(list 'invisible 'org-link
'keymap org-mouse-map 'mouse-face 'highlight
- 'font-lock-multiline t 'help-echo help)))
+ 'font-lock-multiline t 'help-echo help
+ 'htmlize-link `(:uri ,hl))))
(vp (list 'keymap org-mouse-map 'mouse-face 'highlight
- 'font-lock-multiline t 'help-echo help)))
+ 'font-lock-multiline t 'help-echo help
+ 'htmlize-link `(:uri ,hl))))
;; 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))
@@ -5573,97 +6036,55 @@ by a #."
(goto-char e)
t)))
-(defvar org-latex-and-specials-regexp nil
- "Regular expression for highlighting export special stuff.")
+(defvar org-latex-and-related-regexp nil
+ "Regular expression for highlighting LaTeX, entities and sub/superscript.")
(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-compute-latex-and-related-regexp ()
+ "Compute regular expression for LaTeX, entities and sub/superscript.
+Result depends on variable `org-highlight-latex-and-related'."
+ (org-set-local
+ 'org-latex-and-related-regexp
+ (let* ((re-sub
+ (cond ((not (memq 'script org-highlight-latex-and-related)) nil)
+ ((eq org-use-sub-superscripts '{})
+ (list org-match-substring-with-braces-regexp))
+ (org-use-sub-superscripts (list org-match-substring-regexp))))
+ (re-latex
+ (when (memq 'latex org-highlight-latex-and-related)
+ (let ((matchers (plist-get org-format-latex-options :matchers)))
+ (delq nil
+ (mapcar (lambda (x)
+ (and (member (car x) matchers) (nth 1 x)))
+ org-latex-regexps)))))
+ (re-entities
+ (when (memq 'entities org-highlight-latex-and-related)
+ (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))))
+ (mapconcat 'identity (append re-latex re-entities re-sub) "\\|"))))
+
+(defun org-do-latex-and-related (limit)
+ "Highlight LaTeX snippets and environments, entities and sub/superscript.
+LIMIT bounds the search for syntax to highlight. Stop at first
+highlighted object, if any. Return t if some highlighting was
+done, nil otherwise."
+ (when (org-string-nw-p org-latex-and-related-regexp)
+ (catch 'found
+ (while (re-search-forward org-latex-and-related-regexp limit t)
+ (unless (memq (car-safe (get-text-property (1+ (match-beginning 0))
+ 'face))
+ '(org-code org-verbatim underline))
+ (let ((offset (if (memq (char-after (1+ (match-beginning 0)))
+ '(?_ ?^))
+ 1
+ 0)))
+ (font-lock-prepend-text-property
+ (+ offset (match-beginning 0)) (match-end 0)
+ 'face 'org-latex-and-related)
+ (add-text-properties (+ offset (match-beginning 0)) (match-end 0)
+ '(font-lock-multiline t)))
+ (throw 'found t)))
+ nil)))
(defun org-restart-font-lock ()
"Restart `font-lock-mode', to force refontification."
@@ -5673,13 +6094,17 @@ by a #."
(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)
+When optional argument RADIO is non-nil, 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))))
+ ;; Make sure point is really within the object.
+ (backward-char)
+ (let ((obj (org-element-context)))
+ (when (memq (org-element-type obj) '(radio-target target))
+ (add-to-list 'rtn (downcase (org-element-property :value obj))))))
rtn)))
(defun org-make-target-link-regexp (targets)
@@ -5711,18 +6136,34 @@ between words."
(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)))))
+ (if (not (condition-case nil
+ (org-back-to-heading t)
+ (error nil)))
+ 0
+ (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.")
+(defsubst org-re-property (property &optional literal)
+ "Return a regexp matching a PROPERTY line.
+Match group 3 will be set to the value if it exists."
+ (concat "^\\(?4:[ \t]*\\)\\(?1::\\(?2:"
+ (if literal property (regexp-quote property))
+ "\\):\\)[ \t]+\\(?3:[^ \t\r\n].*?\\)\\(?5:[ \t]*\\)$"))
+
+(defconst org-property-re
+ (org-re-property ".*?" 'literal)
+ "Regular expression matching a property line.
+There are four matching groups:
+1: :PROPKEY: including the leading and trailing colon,
+2: PROPKEY without the leading and trailing colon,
+3: PROPVAL without leading or trailing spaces,
+4: the indentation of the current line,
+5: trailing whitespace.")
(defvar org-font-lock-hook nil
"Functions to be called for special font lock stuff.")
@@ -5770,12 +6211,17 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; 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 'plain lk) '(org-activate-plain-links (0 'org-link t)))
(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))
+ ;; Targets.
+ (list org-any-target-regexp '(0 'org-target t))
+ ;; Diary sexps.
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
+ ;; Macro
+ '("{{{.+}}}" (0 'org-macro t))
'(org-hide-wide-columns (0 nil append))
;; TODO keyword
(list (format org-heading-keyword-regexp-format
@@ -5794,6 +6240,12 @@ needs to be inserted at a specific position in the font-lock sequence.")
'(org-font-lock-add-priority-faces)
;; Tags
'(org-font-lock-add-tag-faces)
+ ;; Tags groups
+ (if (and org-group-tags org-tag-groups-alist)
+ (list (concat org-outline-regexp-bol ".+\\(:"
+ (regexp-opt (mapcar 'car org-tag-groups-alist))
+ ":\\).*$")
+ '(1 'org-tag-group prepend)))
;; Special keywords
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
@@ -5819,7 +6271,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
"\\(.*:" org-archive-tag ":.*\\)")
'(1 'org-archived prepend))
;; Specials
- '(org-do-latex-and-special-faces)
+ '(org-do-latex-and-related)
'(org-fontify-entities)
'(org-raise-scripts)
;; Code
@@ -5831,8 +6283,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
"\\)"))
'(2 'org-special-keyword t))
;; Blocks and meta lines
- '(org-fontify-meta-lines-and-blocks)
- )))
+ '(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
@@ -5847,11 +6298,11 @@ needs to be inserted at a specific position in the font-lock sequence.")
(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")
+ (message "Entities are now displayed as UTF8 characters")
(save-restriction
(widen)
(org-decompose-region (point-min) (point-max))
- (message "Entities are displayed plain"))))
+ (message "Entities are now displayed as plain text"))))
(defvar org-custom-properties-overlays nil
"List of overlays used for custom properties.")
@@ -5960,10 +6411,10 @@ When FACE-OR-COLOR is not a string, just return it."
(add-text-properties
(match-beginning 0) (match-end 0)
(list 'face (or (org-face-from-face-or-color
- 'priority 'org-special-keyword
+ 'priority 'org-priority
(cdr (assoc (char-after (match-beginning 1))
org-priority-faces)))
- 'org-special-keyword)
+ 'org-priority)
'font-lock-fontified t)))))
(defun org-get-tag-face (kwd)
@@ -6021,10 +6472,10 @@ and subscripts."
(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]*#"))
+ 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)) ;????????????????????
+ ;; Handle a_b^c
+ (if (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
(if (or comment-p emph-p link-p keyw-p)
t
(put-text-property (match-beginning 3) (match-end 0)
@@ -6052,11 +6503,18 @@ and subscripts."
(defvar org-cycle-global-status nil)
(make-variable-buffer-local 'org-cycle-global-status)
+(put 'org-cycle-global-status 'org-state t)
(defvar org-cycle-subtree-status nil)
(make-variable-buffer-local 'org-cycle-subtree-status)
+(put 'org-cycle-subtree-status 'org-state t)
(defvar org-inlinetask-min-level)
+(defun org-unlogged-message (&rest args)
+ "Display a message, but avoid logging it in the *Messages* buffer."
+ (let ((message-log-max nil))
+ (apply 'message args)))
+
;;;###autoload
(defun org-cycle (&optional arg)
"TAB-action and visibility cycling for Org-mode.
@@ -6142,11 +6600,11 @@ in special contexts.
((equal arg '(16))
(setq last-command 'dummy)
(org-set-startup-visibility)
- (message "Startup visibility, plus VISIBILITY properties"))
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
((equal arg '(64))
(show-all)
- (message "Entire buffer visible, including drawers"))
+ (org-unlogged-message "Entire buffer visible, including drawers"))
;; Table: enter it or move to the next field.
((org-at-table-p 'any)
@@ -6233,9 +6691,9 @@ in special contexts.
;; 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..."))
+ (unless ga (org-unlogged-message "CONTENTS..."))
(org-content)
- (unless ga (message "CONTENTS...done"))
+ (unless ga (org-unlogged-message "CONTENTS...done"))
(setq org-cycle-global-status 'contents)
(run-hook-with-args 'org-cycle-hook 'contents))
@@ -6244,7 +6702,7 @@ in special contexts.
;; 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"))
+ (unless ga (org-unlogged-message "SHOW ALL"))
(setq org-cycle-global-status 'all)
(run-hook-with-args 'org-cycle-hook 'all))
@@ -6252,7 +6710,7 @@ in special contexts.
;; Default action: go to overview
(run-hook-with-args 'org-pre-cycle-hook 'overview)
(org-overview)
- (unless ga (message "OVERVIEW"))
+ (unless ga (org-unlogged-message "OVERVIEW"))
(setq org-cycle-global-status 'overview)
(run-hook-with-args 'org-cycle-hook 'overview)))))
@@ -6298,7 +6756,7 @@ in special contexts.
;; Nothing is hidden behind this heading
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'empty))
- (message "EMPTY ENTRY")
+ (org-unlogged-message "EMPTY ENTRY")
(setq org-cycle-subtree-status nil)
(save-excursion
(goto-char eos)
@@ -6332,8 +6790,8 @@ in special contexts.
(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")
+ (goto-char (if (< end eos) end eos)))))))
+ (org-unlogged-message "CHILDREN")
(save-excursion
(goto-char eos)
(outline-next-heading)
@@ -6349,7 +6807,8 @@ in special contexts.
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'subtree))
(outline-flag-region eoh eos nil)
- (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
+ (org-unlogged-message
+ (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
(setq org-cycle-subtree-status 'subtree)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'subtree)))
@@ -6357,7 +6816,7 @@ in special contexts.
;; Default action: hide the subtree.
(run-hook-with-args 'org-pre-cycle-hook 'folded)
(outline-flag-region eoh eos t)
- (message "FOLDED")
+ (org-unlogged-message "FOLDED")
(setq org-cycle-subtree-status 'folded)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'folded))))))
@@ -6377,7 +6836,7 @@ With a numeric prefix, show all headlines up to that level."
(setq org-cycle-global-status 'contents))
((equal arg '(4))
(org-set-startup-visibility)
- (message "Startup visibility, plus VISIBILITY properties."))
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
(t
(org-cycle '(4))))))
@@ -6438,7 +6897,7 @@ 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 ((l (org-current-line))
+ (let ((pos (point))
(level (save-excursion
(goto-char (point-min))
(if (re-search-forward (concat "^" outline-regexp) nil t)
@@ -6447,7 +6906,7 @@ results."
(funcall outline-level))))))
(and level (hide-sublevels level))
(recenter '(4))
- (org-goto-line l)))
+ (goto-char pos)))
(defun org-content (&optional arg)
"Show all headlines in the buffer, like a table of contents.
@@ -6611,6 +7070,21 @@ open and agenda-wise Org files."
(while (re-search-forward org-drawer-regexp end t)
(org-flag-drawer t))))))
+(defun org-cycle-hide-inline-tasks (state)
+ "Re-hide inline tasks when switching to 'contents or 'children
+visibility state."
+ (case state
+ (contents
+ (when (org-bound-and-true-p org-inlinetask-min-level)
+ (hide-sublevels (1- org-inlinetask-min-level))))
+ (children
+ (when (featurep 'org-inlinetask)
+ (save-excursion
+ (while (and (outline-next-heading)
+ (org-inlinetask-at-task-p))
+ (org-inlinetask-toggle-visibility)
+ (org-inlinetask-goto-end)))))))
+
(defun org-flag-drawer (flag)
"When FLAG is non-nil, hide the drawer we are within.
Otherwise make it visible."
@@ -6622,7 +7096,7 @@ Otherwise make it visible."
"^[ \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))))))
+ (user-error ":END: line missing at position %s" b))))))
(defun org-subtree-end-visible-p ()
"Is the end of the current subtree visible?"
@@ -6754,7 +7228,7 @@ Optional arguments START and END can be used to limit the range."
'org-hide-block)
(delete-overlay ov))))
(push ov org-hide-block-overlays)))
- (error "Not looking at a source block"))))
+ (user-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)
@@ -6812,7 +7286,6 @@ RET=jump to location C-g=quit and return to previous location
(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.
@@ -6948,7 +7421,7 @@ or nil."
(setq org-goto-selected-point (point)
org-goto-exit-command 'left)
(throw 'exit nil))
- (error "Not on a heading")))
+ (user-error "Not on a heading")))
(defun org-goto-right ()
"Finish `org-goto' by going to the new location."
@@ -6958,7 +7431,7 @@ or nil."
(setq org-goto-selected-point (point)
org-goto-exit-command 'right)
(throw 'exit nil))
- (error "Not on a heading")))
+ (user-error "Not on a heading")))
(defun org-goto-quit ()
"Finish `org-goto' without cursor motion."
@@ -7060,132 +7533,171 @@ frame is not changed."
;;; Inserting headlines
-(defun org-previous-line-empty-p ()
+(defun org-previous-line-empty-p (&optional next)
+ "Is the previous line a blank line?
+When NEXT is non-nil, check the next line instead."
(save-excursion
(and (not (bobp))
- (or (beginning-of-line 0) t)
+ (or (beginning-of-line (if next 2 0)) t)
(save-match-data
(looking-at "[ \t]*$")))))
-(defun org-insert-heading (&optional force-heading invisible-ok)
+(defun org-insert-heading (&optional arg 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').
+If point is in a plain list and ARG is nil, create a new list item.
+With one universal prefix argument, insert a heading even in lists.
+With two universal prefix arguments, insert the heading at the end
+of the parent subtree.
+
+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
+and create a new headline with the text in the current line after point
+\(see `org-M-RET-may-split-line' on how to modify this behavior).
+
+If point is at the beginning of a normal line, turn this line into
+a heading.
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)
+ (if (org-called-interactively-p 'any) (org-reveal))
+ (let ((itemp (org-in-item-p))
+ (may-split (org-get-alist-option org-M-RET-may-split-line 'headline))
+ (respect-content (or org-insert-heading-respect-content
+ (equal arg '(16))))
+ (initial-content "")
+ (adjust-empty-lines t))
+
+ (cond
+
+ ((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
+ (or arg (not itemp))))
+ ;; At beginning of buffer or so high up that only a heading
+ ;; makes sense.
+ (insert
+ (if (or (bobp) (org-previous-line-empty-p)) "" "\n")
+ (if (org-in-src-block-p) ",* " "* "))
+ (run-hooks 'org-insert-heading-hook))
+
+ ((and itemp (not (equal arg '(4))))
+ ;; Insert an item
+ (org-insert-item))
+
+ (t
+ ;; Insert a heading
+ (save-restriction
+ (widen)
+ (let* ((level nil)
+ (on-heading (org-at-heading-p))
+ (empty-line-p (if on-heading
+ (org-previous-line-empty-p)
+ ;; We will decide later
+ nil))
+ ;; Get a level string to fall back on
+ (fix-level
(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)))))
+ (org-back-to-heading t)
+ (if (org-previous-line-empty-p) (setq empty-line-p t))
+ (looking-at org-outline-regexp)
+ (make-string (1- (length (match-string 0))) ?*)))
+ (stars
+ (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")))
+ (unless (and (save-excursion
+ (save-match-data
+ (org-backward-heading-same-level
+ 1 invisible-ok))
+ (= (point) (match-beginning 0)))
+ (not (org-previous-line-empty-p t)))
+ (setq empty-line-p (or empty-line-p
+ (org-previous-line-empty-p))))
+ (match-string 0))
+ (error (or fix-level "* ")))))
+ (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)
+
+ ;; If we insert after content, move there and clean up whitespace
+ (when respect-content
+ (org-end-of-subtree nil t)
+ (skip-chars-backward " \r\n")
+ (and (looking-at "[ \t]+") (replace-match ""))
+ (unless (eobp) (forward-char 1))
+ (when (looking-at "^\\*")
+ (unless (bobp) (backward-char 1))
+ (insert "\n")))
+
+ ;; If we are splitting, grab the text that should be moved to the new headline
+ (when may-split
+ (if (org-on-heading-p)
+ ;; This is a heading, we split intelligently (keeping tags)
+ (let ((pos (point)))
+ (goto-char (point-at-bol))
+ (unless (looking-at org-complex-heading-regexp)
+ (error "This should not happen"))
+ (when (and (match-beginning 4)
+ (> pos (match-beginning 4))
+ (< pos (match-end 4)))
+ (setq initial-content (buffer-substring pos (match-end 4)))
+ (goto-char pos)
+ (delete-region (point) (match-end 4))
+ (if (looking-at "[ \t]*$")
+ (replace-match "")
+ (insert (make-string (length initial-content) ?\ )))
+ (setq initial-content (org-trim initial-content)))
+ (goto-char pos))
+ ;; a normal line
+ (unless (bolp)
+ (setq initial-content (buffer-substring (point) (point-at-eol)))
+ (delete-region (point) (point-at-eol))
+ (setq initial-content (org-trim initial-content)))))
+
+ ;; If we are at the beginning of the line, insert before it. Else after
+ (cond
+ ((and (bolp) (looking-at "[ \t]*$")))
+ ((and (bolp) (not (looking-at "[ \t]*$")))
+ (open-line 1))
+ (t
+ (goto-char (point-at-eol))
+ (insert "\n")))
+
+ ;; Insert the new heading
+ (insert stars)
+ (just-one-space)
+ (insert initial-content)
+ (when adjust-empty-lines
+ (if (or (not blank)
+ (and blank (not (org-previous-line-empty-p))))
+ (org-N-empty-lines-before-current (if blank 1 0))))
+ (run-hooks 'org-insert-heading-hook)))))))
+
+(defun org-N-empty-lines-before-current (N)
+ "Make the number of empty lines before current exactly N.
+So this will delete or add empty lines."
+ (save-excursion
+ (goto-char (point-at-bol))
+ (if (looking-back "\\s-+" nil 'greedy)
+ (replace-match ""))
+ (or (bobp) (insert "\n"))
+ (while (> N 0)
+ (insert "\n")
+ (setq N (1- N)))))
(defun org-get-heading (&optional no-tags no-todo)
"Return the heading of the current entry, without the stars.
@@ -7208,6 +7720,8 @@ When NO-TODO is non-nil, don't include TODO keywords."
(t (looking-at org-heading-regexp)
(match-string 2)))))
+(defvar orgstruct-mode) ; defined below
+
(defun org-heading-components ()
"Return the components of the current heading.
This is a list with the following elements:
@@ -7219,13 +7733,24 @@ This is a list with the following elements:
- 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)))))
+ (if (let (case-fold-search)
+ (looking-at
+ (if orgstruct-mode
+ org-heading-regexp
+ org-complex-heading-regexp)))
+ (if orgstruct-mode
+ (list (length (match-string 1))
+ (org-reduced-level (length (match-string 1)))
+ nil
+ nil
+ (match-string 2)
+ nil)
+ (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."
@@ -7241,25 +7766,27 @@ This is a list with the following elements:
(org-move-subtree-down)
(end-of-line 1))
-(defun org-insert-heading-respect-content (invisible-ok)
+(defun org-insert-heading-respect-content (&optional arg invisible-ok)
"Insert heading with `org-insert-heading-respect-content' set to t."
(interactive "P")
(let ((org-insert-heading-respect-content t))
- (org-insert-heading t invisible-ok)))
+ (org-insert-heading '(4) invisible-ok)))
(defun org-insert-todo-heading-respect-content (&optional force-state)
"Insert TODO heading with `org-insert-heading-respect-content' set to t."
(interactive "P")
(let ((org-insert-heading-respect-content t))
- (org-insert-todo-heading force-state t)))
+ (org-insert-todo-heading force-state '(4))))
(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."
+state (TODO by default). Also one prefix arg, force first state. With two
+prefix args, force inserting at the end of the parent subtree."
(interactive "P")
(when (or force-heading (not (org-insert-item 'checkbox)))
- (org-insert-heading force-heading)
+ (org-insert-heading (or (and (equal arg '(16)) '(16))
+ force-heading))
(save-excursion
(org-back-to-heading)
(outline-previous-heading)
@@ -7433,7 +7960,7 @@ in the region."
org-allow-promoting-top-level-subtree)
(replace-match "# " nil t))
((= level 1)
- (error "Cannot promote to level 0. UNDO to recover if necessary"))
+ (user-error "Cannot promote to level 0. UNDO to recover if necessary"))
(t (replace-match up-head nil t)))
;; Fixup tag positioning
(unless (= level 1)
@@ -7627,7 +8154,7 @@ case."
(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")))
+ (user-error "Cannot move past superior level or buffer limit")))
(setq cnt (1- cnt)))
(if (> arg 0)
;; Moving forward - still need to move over subtree
@@ -7687,9 +8214,9 @@ 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.
+(defun org-copy-subtree (&optional n cut force-store-markers nosubtrees)
+ "Copy the current subtree it in the clipboard.
+With prefix arg N, copy 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
@@ -7703,12 +8230,14 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(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))
+ (if nosubtrees
+ (outline-next-heading)
+ (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)))
(setq end (point))
(goto-char beg0)
(when (> end beg)
@@ -7727,7 +8256,7 @@ 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
+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
@@ -7748,7 +8277,7 @@ 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"
+ (user-error "%s"
(substitute-command-keys
"The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
(org-with-limited-levels
@@ -7909,7 +8438,7 @@ If yes, remember the marker and the distance to BEG."
"^[ \t]*#\\+end_.*")))
(if blockp
(narrow-to-region (car blockp) (cdr blockp))
- (error "Not in a block"))))
+ (user-error "Not in a block"))))
(eval-when-compile
(defvar org-property-drawer-re))
@@ -7920,8 +8449,10 @@ If yes, remember the marker and the distance to BEG."
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'.
+clones to be produced. If the entry has a timestamp, the user
+will also be prompted for a time shift, which may be a repeater
+as used in time stamps, for example `+3d'. To disable this,
+you can call the function with a universal prefix argument.
When a valid repeater is given and the entry contains any time
stamps, the clones will become a sequence in time, with time
@@ -7940,10 +8471,22 @@ the following will happen:
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))
+ (interactive "nNumber of clones to produce: ")
+ (let ((shift
+ (or shift
+ (if (and (not (equal current-prefix-arg '(4)))
+ (save-excursion
+ (re-search-forward org-ts-regexp-both
+ (save-excursion
+ (org-end-of-subtree t)
+ (point)) t)))
+ (read-from-minibuffer
+ "Date shift per clone (e.g. +1w, empty to copy unchanged): ")
+ ""))) ;; No time shift
+ (n-no-remove -1)
+ (drawer-re org-drawer-regexp)
+ beg end template task idprop
+ shift-n shift-what doshift nmin nmax)
(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)))
@@ -8015,11 +8558,16 @@ Optional argument WITH-CASE means sort case-sensitively."
(org-call-with-arg 'org-sort-entries with-case))))
(defun org-sort-remove-invisible (s)
+ "Remove invisible links from string 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)))
+ (let ((st (format " %s " s)))
+ (while (string-match org-emph-re st)
+ (setq st (replace-match (format " %s " (match-string 4 st)) t t st)))
+ (setq s (substring st 1 -1)))
s)
(defvar org-priority-regexp) ; defined later in the file
@@ -8038,7 +8586,7 @@ 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.
+a time stamp, by a property, by priority order, or by a custom function.
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,
@@ -8064,7 +8612,10 @@ 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."
+WITH-CASE, the sorting considers case as well.
+
+Sorting is done against the visible part of the headlines, it ignores hidden
+links."
(interactive "P")
(let ((case-func (if with-case 'identity 'downcase))
(cmstr
@@ -8115,7 +8666,7 @@ WITH-CASE, the sorting considers case as well."
(show-all)))
(setq beg (point))
- (if (>= beg end) (error "Nothing to sort"))
+ (if (>= beg end) (user-error "Nothing to sort"))
(looking-at "\\(\\*+\\)")
(setq stars (match-string 1)
@@ -8124,7 +8675,7 @@ WITH-CASE, the sorting considers case as well."
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"))
+ (user-error "Region to sort contains a level above the first entry"))
(unless sorting-type
(message
@@ -8134,13 +8685,15 @@ WITH-CASE, the sorting considers case as well."
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)))
+ (unless getkey-func
+ (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)
+ (not property)
(setq property
(org-icompleting-read "Property: "
(mapcar 'list (org-buffer-property-keys t))
@@ -8174,11 +8727,11 @@ WITH-CASE, the sorting considers case as well."
(cond
((= dcst ?n)
(if (looking-at org-complex-heading-regexp)
- (string-to-number (match-string 4))
+ (string-to-number (org-sort-remove-invisible (match-string 4)))
nil))
((= dcst ?a)
(if (looking-at org-complex-heading-regexp)
- (funcall case-func (match-string 4))
+ (funcall case-func (org-sort-remove-invisible (match-string 4)))
nil))
((= dcst ?t)
(let ((end (save-excursion (outline-next-heading) (point))))
@@ -8296,12 +8849,23 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
;; 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.
+(defcustom orgstruct-heading-prefix-regexp nil
+ "Regexp that matches the custom prefix of Org headlines in
+orgstruct(++)-mode."
+ :group 'org
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp)
+
+(defcustom orgstruct-setup-hook nil
+ "Hook run after orgstruct-mode-map is filled."
+ :group 'org
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'hook)
-(defvar orgstruct-mode-map (make-sparse-keymap)
- "Keymap for the minor `orgstruct-mode'.")
+(defvar orgstruct-initialized nil)
(defvar org-local-vars nil
"List of local variables, for use by `orgstruct-mode'.")
@@ -8312,26 +8876,17 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
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)))
+defined by Org-mode)."
+ nil " OrgStruct" (make-sparse-keymap)
+ (funcall (if orgstruct-mode
+ 'add-to-invisibility-spec
+ 'remove-from-invisibility-spec)
+ '(outline . t))
+ (when orgstruct-mode
+ (org-load-modules-maybe)
+ (unless orgstruct-initialized
+ (orgstruct-setup)
+ (setq orgstruct-initialized t))))
;;;###autoload
(defun turn-on-orgstruct ()
@@ -8355,6 +8910,8 @@ buffer. It will also recognize item context in multiline items."
org-fb-vars))
(orgstruct-mode 1)
(setq org-fb-vars nil)
+ (unless org-local-vars
+ (setq org-local-vars (org-get-local-variables)))
(let (var val)
(mapc
(lambda (x)
@@ -8379,107 +8936,164 @@ buffer. It will also recognize item context in multiline items."
(defun orgstruct-error ()
"Error when there is no default binding for a structure key."
(interactive)
- (error "This key has no function outside structure elements"))
+ (funcall (if (fboundp 'user-error)
+ 'user-error
+ '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)
+ "Setup orgstruct keymap."
+ (dolist (cell '((org-demote . t)
+ (org-metaleft . t)
+ (org-metaright . t)
+ (org-promote . t)
+ (org-shiftmetaleft . t)
+ (org-shiftmetaright . t)
+ org-backward-element
+ org-backward-heading-same-level
+ org-ctrl-c-ret
+ org-ctrl-c-minus
+ org-ctrl-c-star
+ org-cycle
+ org-forward-heading-same-level
+ org-insert-heading
+ org-insert-heading-respect-content
+ org-kill-note-or-show-branches
+ org-mark-subtree
+ org-meta-return
+ org-metadown
+ org-metaup
+ org-narrow-to-subtree
+ org-promote-subtree
+ org-reveal
+ org-shiftdown
+ org-shiftleft
+ org-shiftmetadown
+ org-shiftmetaup
+ org-shiftright
+ org-shifttab
+ org-shifttab
+ org-shiftup
+ org-show-subtree
+ org-sort
+ org-up-element
+ outline-demote
+ outline-next-visible-heading
+ outline-previous-visible-heading
+ outline-promote
+ outline-up-heading
+ show-children))
+ (let ((f (or (car-safe cell) cell))
+ (disable-when-heading-prefix (cdr-safe cell)))
+ (when (fboundp f)
+ (let ((new-bindings))
+ (dolist (binding (nconc (where-is-internal f org-mode-map)
+ (where-is-internal f outline-mode-map)))
+ (push binding new-bindings)
+ ;; TODO use local-function-key-map
+ (dolist (rep '(("<tab>" . "TAB")
+ ("<return>" . "RET")
+ ("<escape>" . "ESC")
+ ("<delete>" . "DEL")))
+ (setq binding (read-kbd-macro
+ (let ((case-fold-search))
+ (replace-regexp-in-string
+ (regexp-quote (cdr rep))
+ (car rep)
+ (key-description binding)))))
+ (pushnew binding new-bindings :test 'equal)))
+ (dolist (binding new-bindings)
+ (let ((key (lookup-key orgstruct-mode-map binding)))
+ (when (or (not key) (numberp key))
+ (condition-case nil
+ (org-defkey orgstruct-mode-map
+ binding
+ (orgstruct-make-binding f binding disable-when-heading-prefix))
+ (error nil)))))))))
+ (run-hooks 'orgstruct-setup-hook))
+
+(defun orgstruct-make-binding (fun key disable-when-heading-prefix)
"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))))))))
+FUN is the command to call inside a table. KEY is the key that
+should be checked in for a command to execute outside of tables.
+Non-nil DISABLE-WHEN-HEADING-PREFIX means to disable the command
+if `orgstruct-heading-prefix-regexp' is non-nil."
+ (let ((name (concat "orgstruct-hijacker-" (symbol-name fun))))
+ (let ((nname name)
+ (i 0))
+ (while (fboundp (intern nname))
+ (setq nname (format "%s-%d" name (setq i (1+ i)))))
+ (setq name (intern nname)))
+ (eval
+ (let ((bindings '((org-heading-regexp
+ (concat "^"
+ orgstruct-heading-prefix-regexp
+ "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$"))
+ (org-outline-regexp
+ (concat orgstruct-heading-prefix-regexp "\\*+ "))
+ (org-outline-regexp-bol
+ (concat "^" org-outline-regexp))
+ (outline-regexp org-outline-regexp)
+ (outline-heading-end-regexp "\n")
+ (outline-level 'org-outline-level)
+ (outline-heading-alist))))
+ `(defun ,name (arg)
+ ,(concat "In Structure, run `" (symbol-name fun) "'.\n"
+ "Outside of structure, run the binding of `"
+ (key-description key) "'."
+ (when disable-when-heading-prefix
+ (concat
+ "\nIf `orgstruct-heading-prefix-regexp' is non-nil, this command will always fall\n"
+ "back to the default binding due to limitations of Org's implementation of\n"
+ "`" (symbol-name fun) "'.")))
+ (interactive "p")
+ (let* ((disable
+ ,(when disable-when-heading-prefix
+ '(and orgstruct-heading-prefix-regexp
+ (not (string= orgstruct-heading-prefix-regexp "")))))
+ (fallback
+ (or disable
+ (not
+ (let* ,bindings
+ (org-context-p 'headline 'item
+ ,(when (memq fun
+ '(org-insert-heading
+ org-insert-heading-respect-content
+ org-meta-return))
+ '(when orgstruct-is-++
+ 'item-body))))))))
+ (if fallback
+ (let* ((orgstruct-mode)
+ (binding
+ (loop with key = ,key
+ for rep in
+ '(nil
+ ("<\\([^>]*\\)tab>" . "\\1TAB")
+ ("<\\([^>]*\\)return>" . "\\1RET")
+ ("<\\([^>]*\\)escape>" . "\\1ESC")
+ ("<\\([^>]*\\)delete>" . "\\1DEL"))
+ do
+ (when rep
+ (setq key (read-kbd-macro
+ (let ((case-fold-search))
+ (replace-regexp-in-string
+ (car rep)
+ (cdr rep)
+ (key-description key))))))
+ thereis (key-binding key))))
+ (if (keymapp binding)
+ (set-temporary-overlay-map binding)
+ (let ((func (or binding
+ (unless disable
+ 'orgstruct-error))))
+ (when func
+ (call-interactively func)))))
+ (org-run-like-in-org-mode
+ (lambda ()
+ (interactive)
+ (let* ,bindings
+ (call-interactively ',fun)))))))))
+ name))
(defun org-contextualize-keys (alist contexts)
"Return valid elements in ALIST depending on CONTEXTS.
@@ -8543,11 +9157,15 @@ definitions."
(string-match (cdr rr) (buffer-file-name)))
(and (eq (car rr) 'in-mode)
(string-match (cdr rr) (symbol-name major-mode)))
+ (and (eq (car rr) 'in-buffer)
+ (string-match (cdr rr) (buffer-name)))
(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)))))))
+ (not (string-match (cdr rr) (symbol-name major-mode))))
+ (when (eq (car rr) 'not-in-buffer)
+ (not (string-match (cdr rr) (buffer-name)))))))
(push r res)))
(car (last r))))
(delete-dups (delq nil res))))
@@ -8576,17 +9194,18 @@ Possible values in the list of contexts are `table', `headline', and `item'."
(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))))
+ (mapcar
+ (lambda (x)
+ (setq x
+ (if (symbolp x)
+ (list x)
+ (list (car x) (cdr x))))
+ (if (and (not (get (car x) 'org-state))
+ (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.
@@ -8609,8 +9228,14 @@ 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)))))
+ (let (binds)
+ (dolist (var org-local-vars)
+ (when (or (not (boundp (car var)))
+ (eq (symbol-value (car var))
+ (default-value (car var))))
+ (push (list (car var) `(quote ,(cadr var))) binds)))
+ (eval `(let ,binds
+ (call-interactively (quote ,cmd))))))
;;;; Archiving
@@ -8636,7 +9261,7 @@ call CMD."
((symbolp org-category) (symbol-name org-category))
(t org-category)))
beg end cat pos optionp)
- (org-unmodified
+ (org-with-silent-modifications
(save-excursion
(save-restriction
(widen)
@@ -8661,7 +9286,7 @@ DPROP is the drawer property and TPROP is the corresponding text
property to set."
(let ((case-fold-search t)
(inhibit-read-only t) p)
- (org-unmodified
+ (org-with-silent-modifications
(save-excursion
(save-restriction
(widen)
@@ -8671,7 +9296,7 @@ property to set."
(save-excursion
(org-back-to-heading t)
(put-text-property
- (point-at-bol) (point-at-eol) tprop p))))))))
+ (point-at-bol) (org-end-of-subtree t t) tprop p))))))))
;;;; Link Stuff
@@ -8692,7 +9317,9 @@ property to set."
(cond
((symbolp rpl) (funcall rpl tag))
((string-match "%(\\([^)]+\\))" rpl)
- (replace-match (funcall (intern-soft (match-string 1 rpl)) tag) t t rpl))
+ (replace-match
+ (save-match-data
+ (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))
@@ -8774,191 +9401,237 @@ type. For a simple example of an export function, see `org-bbdb.el'."
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
+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'.
- ((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)))
+A double prefix arg force skipping storing functions that are not
+part of Org's core.
- ((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"))
+A triple prefix arg force storing a link for each line in the
+active region."
+ (interactive "P")
+ (org-load-modules-maybe)
+ (if (and (equal arg '(64)) (org-region-active-p))
+ (save-excursion
+ (let ((end (region-end)))
+ (goto-char (region-beginning))
+ (set-mark (point))
+ (while (< (point-at-eol) end)
+ (move-end-of-line 1) (activate-mark)
+ (let (current-prefix-arg)
+ (call-interactively 'org-store-link))
+ (move-beginning-of-line 2)
+ (set-mark (point)))))
+ (org-with-limited-levels
+ (setq org-store-link-plist nil)
+ (let (link cpltxt desc description search
+ txt custom-id agenda-link sfuns sfunsn)
(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-id-link-to-org-use-id t)
- (and (org-called-interactively-p 'any)
- (or (eq org-id-link-to-org-use-id 'create-if-interactive)
- (and (eq org-id-link-to-org-use-id
- 'create-if-interactive-and-no-custom-id)
- (not custom-id))))
- (and org-id-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
+
+ ;; Store a link using an external link type
+ ((and (not (equal arg '(16)))
+ (setq sfuns
+ (delq
+ nil (mapcar (lambda (f)
+ (let (fs) (if (funcall f) (push f fs))))
+ org-store-link-functions))
+ sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
+ (or (and (cdr sfuns)
+ (funcall (intern
+ (completing-read
+ "Which function for creating the link? "
+ sfunsn t (car sfunsn)))))
+ (funcall (caar sfuns)))
+ (setq link (plist-get org-store-link-plist :link)
+ desc (or (plist-get org-store-link-plist
+ :description) link))))
+
+ ;; Store a link from a source code buffer
+ ((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)))
+
+ ;; We are in the agenda, link to referenced location
+ ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
+ (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 'image-mode)
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name buffer-file-name))
+ link cpltxt)
+ (org-store-link-props :type "image" :file buffer-file-name))
+
+ ;; In dired, store a link to the file of the current line
+ ((eq major-mode 'dired-mode)
+ (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)))
+
+ ((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)))
+
+ ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ (setq custom-id (org-entry-get nil "CUSTOM_ID"))
+ (cond
+ ;; Store a link using the target at point
+ ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
+ (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-id-link-to-org-use-id t)
+ (and (org-called-interactively-p 'any)
+ (or (eq org-id-link-to-org-use-id 'create-if-interactive)
+ (and (eq org-id-link-to-org-use-id
+ 'create-if-interactive-and-no-custom-id)
+ (not custom-id))))
+ (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
+ ;; Store a link using the ID at point
+ (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 only to file
+ (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)
+ (let* ((ee (org-element-at-point))
+ (et (org-element-type ee))
+ (ev (plist-get (cadr ee) :value))
+ (ek (plist-get (cadr ee) :key))
+ (eok (and (stringp ek) (string-match "name" ek))))
+ (setq txt (cond
+ ((org-at-heading-p) nil)
+ ((and (eq et 'keyword) eok) ev)
+ ((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 (and (eq et 'keyword) eok ev)
+ (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 search string
+ ;; Add a context 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 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 "::"
- (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)))))))
+ (concat cpltxt "::" (org-make-org-heading-search-string txt))
+ desc "NONE")))
+ (setq link cpltxt))
+
+ ((org-called-interactively-p 'interactive)
+ (user-error "No method for storing a link from this buffer"))
+
+ (t (setq link nil)))
+
+ ;; We're done setting link and desc, clean up
+ (if (consp link) (setq cpltxt (car link) link (cdr link)))
+ (setq link (or link cpltxt)
+ desc (or desc cpltxt))
+ (cond ((equal desc "NONE") (setq desc nil))
+ ((string-match org-bracket-link-analytic-regexp desc)
+ (let ((d0 (match-string 3 desc))
+ (p0 (match-string 5 desc)))
+ (setq desc
+ (replace-regexp-in-string
+ org-bracket-link-regexp
+ (concat (or p0 d0)
+ (if (equal (length (match-string 0 desc))
+ (length desc)) "*" "")) desc)))))
+
+ ;; Return the link
+ (if (not (and (or (org-called-interactively-p 'any)
+ executing-kbd-macro) link))
+ (or agenda-link (and link (org-make-link-string link desc)))
+ (push (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))
+ (push (list link desc) org-stored-links)))))))
(defun org-store-link-props (&rest plist)
"Store link properties, extract names and addresses."
@@ -9015,24 +9688,16 @@ according to FMT (default from `org-email-link-description-format')."
(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)))
+(defun org-make-org-heading-search-string (&optional string)
+ "Make search string for the current headline or STRING."
+ (let ((s (or string
+ (and (derived-mode-p 'org-mode)
+ (save-excursion
+ (org-back-to-heading t)
+ (org-element-property :raw-value (org-element-at-point))))))
(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
+ (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s))
(when (and string (integerp lines) (> lines 0))
(let ((slines (org-split-string s "\n")))
(when (< lines (length slines))
@@ -9079,7 +9744,7 @@ according to FMT (default from `org-email-link-description-format')."
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.")
@@ -9202,7 +9867,7 @@ This command can be called in any mode to insert a link in Org-mode syntax."
(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))
+ (org-insert-link nil (car l) (or (cadr l) "<no description>"))
(insert "\n"))))
(defun org-link-fontify-links-to-this-file ()
@@ -9270,6 +9935,7 @@ If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
be used as the default description."
(interactive "P")
(let* ((wcf (current-window-configuration))
+ (origbuf (current-buffer))
(region (if (org-region-active-p)
(buffer-substring (region-beginning) (region-end))))
(remove (and region (list (region-beginning) (region-end))))
@@ -9324,20 +9990,17 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(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))))
+ (org-completing-read
+ "Link: "
+ (append
+ (mapcar (lambda (x) (concat x ":"))
+ all-prefixes)
+ (mapcar 'car org-stored-links))
+ nil nil nil
+ 'tmphist
+ (caar org-stored-links)))
(if (not (string-match "\\S-" link))
- (error "No link selected"))
+ (user-error "No link selected"))
(mapc (lambda(l)
(when (equal link (cadr l)) (setq link (car l) auto-desc t)))
org-stored-links)
@@ -9345,7 +10008,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(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))))
+ (setq link (with-current-buffer origbuf
+ (org-link-try-special-completion link)))))
(set-window-configuration wcf)
(kill-buffer "*Org Links*"))
(setq entry (assoc link org-stored-links))
@@ -9357,7 +10021,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(setq org-stored-links (delq (assoc link org-stored-links)
org-stored-links)))
- (if (string-match org-plain-link-re link)
+ (if (and (string-match org-plain-link-re link)
+ (not (string-match org-ts-regexp link)))
;; URL-like link, normalize the use of angular brackets.
(setq link (org-remove-angle-brackets link)))
@@ -9429,7 +10094,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(defun org-file-complete-link (&optional arg)
"Create a file link using completion."
(let (file link)
- (setq file (read-file-name "File: "))
+ (setq file (org-iread-file-name "File: "))
(let ((pwd (file-name-as-directory (expand-file-name ".")))
(pwd1 (file-name-as-directory (abbreviate-file-name
(expand-file-name ".")))))
@@ -9447,6 +10112,19 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(t (setq link (concat "file:" file)))))
link))
+(defun org-iread-file-name (&rest args)
+ "Read-file-name using `ido-mode' speedup if available.
+ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'.
+See `read-file-name' for a description of parameters."
+ (org-without-partial-completion
+ (if (and org-completion-use-ido
+ (fboundp 'ido-read-file-name)
+ (boundp 'ido-mode) ido-mode
+ (listp (second args)))
+ (let ((ido-enter-matching-directory nil))
+ (apply 'ido-read-file-name args))
+ (apply 'read-file-name args))))
+
(defun org-completing-read (&rest args)
"Completing-read with SPACE being a normal character."
(let ((enable-recursive-minibuffers t)
@@ -9507,23 +10185,6 @@ from."
(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)
@@ -9545,45 +10206,35 @@ 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 ()
+(defun org-next-link (&optional search-backward)
"Move forward to the next link.
If the link is in hidden text, expose it."
- (interactive)
+ (interactive "P")
(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)
+ (a (assoc :link ct))
+ (srch-fun (if search-backward 're-search-backward 're-search-forward)))
+ (cond (a (goto-char (nth (if search-backward 1 2) a)))
+ ((looking-at org-any-link-re)
+ ;; Don't stay stuck at link without an org-link face
+ (forward-char (if search-backward -1 1))))
+ (if (funcall srch-fun 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"))))
+ (message "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"))))
+ (funcall 'org-next-link t))
(defun org-translate-link (s)
"Translate a link string if a translation function has been defined."
@@ -9614,8 +10265,7 @@ This is still an experimental function, your mileage may vary."
;; 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)))))
- )
+ (org-remove-angle-brackets (match-string 2 path))))))
(cons type path))
(defun org-find-file-at-mouse (ev)
@@ -9743,17 +10393,28 @@ application the system uses for this file type."
(or (previous-single-property-change pos 'org-linked-text)
(point-min))
(or (next-single-property-change pos 'org-linked-text)
- (point-max))))
+ (point-max)))
+ ;; Ensure we will search for a <<<radio>>> link, not
+ ;; a simple reference like <<ref>>
+ path (concat "<" path))
(throw 'match t))
(save-excursion
- (let ((plinkpos (org-in-regexp org-plain-link-re)))
- (when (or (org-in-regexp org-angle-link-re)
- (and plinkpos (goto-char (car plinkpos))
- (save-match-data (not (looking-back "\\[\\[")))))
- (setq type (match-string 1)
- path (org-link-unescape (match-string 2)))
- (throw 'match t))))
+ (when (or (org-in-regexp org-angle-link-re)
+ (let ((match (org-in-regexp org-plain-link-re)))
+ ;; Check a plain link is not within a bracket link
+ (and match
+ (save-excursion
+ (progn
+ (goto-char (car match))
+ (not (org-in-regexp org-bracket-link-regexp))))))
+ (let ((line_ending (save-excursion (end-of-line) (point))))
+ ;; We are in a line before a plain or bracket link
+ (or (re-search-forward org-plain-link-re line_ending t)
+ (re-search-forward org-bracket-link-regexp line_ending t))))
+ (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"
@@ -9814,16 +10475,24 @@ application the system uses for this file type."
(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))))
+ (browse-url
+ (concat type ":"
+ (if (org-string-match-p
+ (concat "[[:nonascii:]"
+ org-link-escape-chars-browser "]")
+ 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))))
+ (browse-url
+ (concat org-doi-server-url
+ (if (org-string-match-p
+ (concat "[[:nonascii:]"
+ org-link-escape-chars-browser "]")
+ path)
+ (org-link-escape path org-link-escape-chars-browser)
+ path))))
((member type '("message"))
(browse-url (concat type ":" path)))
@@ -9879,8 +10548,15 @@ application the system uses for this file type."
(error "Abort"))))
((and (string= type "thisfile")
- (run-hook-with-args-until-success
- 'org-open-link-functions path)))
+ (or (run-hook-with-args-until-success
+ 'org-open-link-functions path)
+ (and link
+ (string-match "^id:" link)
+ (or (featurep 'org-id) (require 'org-id))
+ (progn
+ (funcall (nth 1 (assoc "id" org-link-protocols))
+ (substring path 3))
+ t)))))
((string= type "thisfile")
(if arg
@@ -9958,7 +10634,7 @@ there is one, return it."
(setq nth (- c ?0))
(if have-zero (setq nth (1+ nth)))
(unless (and (integerp nth) (>= (length links) nth))
- (error "Invalid link selection"))
+ (user-error "Invalid link selection"))
(setq link (nth (1- nth) links)))))
(cons link end))))))
@@ -9972,15 +10648,7 @@ there is one, return it."
(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))
+
;;; File search
@@ -10019,9 +10687,9 @@ 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.
+variable `current-prefix-arg'. 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:
@@ -10060,7 +10728,8 @@ visibility around point, thus ignoring
(goto-char (point-min))
(and
(re-search-forward
- (concat "^[ \t]*:CUSTOM_ID:[ \t]+" (regexp-quote (substring s0 1)) "[ \t]*$") nil t)
+ (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
@@ -10079,14 +10748,6 @@ visibility around point, thus ignoring
(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.
@@ -10109,8 +10770,6 @@ visibility around point, thus ignoring
(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)))
@@ -10149,9 +10808,11 @@ visibility around point, thus ignoring
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 "\\(" (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 "\\(" (mapconcat 'downcase words
+ "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
re4 (concat "[^a-zA-Z_]" re4_)
re1 (concat pre re2 post)
@@ -10162,21 +10823,20 @@ visibility around point, thus ignoring
re4 (concat pre (if pre re4_ re4))
reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
"\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
- re5 "\\)"
- ))
+ 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))
+ (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)
- )
+ (org-search-not-self 1 re5 nil t))
(goto-char (match-beginning 1))
(goto-char pos)
(error "No match"))))))
@@ -10416,7 +11076,7 @@ If the file does not exist, an error is thrown."
(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))
+ (user-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.
@@ -10442,9 +11102,9 @@ If the file does not exist, an error is thrown."
(setq match-index (+ match-index 1)))))
(save-window-excursion
+ (message "Running %s...done" cmd)
(start-process-shell-command cmd nil cmd)
- (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
- ))
+ (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)
@@ -10581,9 +11241,10 @@ on the system \"/user@host:\"."
(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
+ ;; 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)
+ (message "Please regenerate the refile cache with `C-0 C-c C-w'")
+ (sit-for 3)
(throw 'exit nil)))
t)))
@@ -10701,8 +11362,7 @@ on the system \"/user@host:\"."
(goto-char (point-at-eol))))))))
(when org-refile-use-cache
(org-refile-cache-put tgs (buffer-file-name) descre))
- (setq targets (append tgs targets))
- ))))
+ (setq targets (append tgs targets))))))
(message "Getting targets...done")
(nreverse targets)))
@@ -10734,14 +11394,21 @@ avoiding backtracing. Refile target collection makes use of that."
(widen)
(while (org-up-heading-safe)
(when (looking-at org-complex-heading-regexp)
- (push (org-match-string-no-properties 4) rtn)))
+ (push (org-trim
+ (replace-regexp-in-string
+ ;; Remove statistical/checkboxes cookies
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (org-match-string-no-properties 4)))
+ rtn)))
rtn)))))
-(defun org-format-outline-path (path &optional width prefix)
+(defun org-format-outline-path (path &optional width prefix separator)
"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."
+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.
+SEPARATOR is inserted between the different parts of the path,
+the default is \"/\"."
(setq width (or width 79))
(if prefix (setq width (- width (length prefix))))
(if (not path)
@@ -10757,6 +11424,7 @@ such as the file name."
(total (1+ (length prefix))))
(setq maxwidth (max maxwidth 10))
(concat prefix
+ (if prefix (or separator "/"))
(mapconcat
(lambda (h)
(setq n (1+ n))
@@ -10773,24 +11441,35 @@ such as the file name."
(nth (% (1- n) org-n-level-faces)
org-level-faces))
h)
- path "/")))))
+ path (or separator "/"))))))
-(defun org-display-outline-path (&optional file current)
- "Display the current outline path in the echo area."
+(defun org-display-outline-path (&optional file current separator just-return-string)
+ "Display the current outline path in the echo area.
+
+If FILE is non-nil, prepend the output with the file name.
+If CURRENT is non-nil, append the current heading to the output.
+SEPARATOR is passed through to `org-format-outline-path'. It separates
+the different parts of the path and defaults to \"/\".
+If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
(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))))
+ (let* (case-fold-search
+ (bfn (buffer-file-name (buffer-base-buffer)))
+ (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
+ res)
(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) "/"))))))
+ (setq res
+ (org-format-outline-path
+ path
+ (1- (frame-width))
+ (and file bfn (concat (file-name-nondirectory bfn) separator))
+ separator))
+ (if just-return-string
+ (org-no-properties res)
+ (org-unlogged-message "%s" res))))
(defvar org-refile-history nil
"History for refiling operations.")
@@ -10801,7 +11480,16 @@ 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)
+(defvar org-refile-keep nil
+ "Non-nil means `org-refile' will copy instead of refile.")
+
+(defun org-copy ()
+ "Like `org-refile', but copy."
+ (interactive)
+ (let ((org-refile-keep t))
+ (funcall 'org-refile nil nil nil "Copy")))
+
+(defun org-refile (&optional goto default-buffer rfloc msg)
"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.
@@ -10820,10 +11508,19 @@ 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.
+
+With a numeric prefix argument of `2', refile to the running clock.
+
+With a numeric prefix argument of `3', emulate `org-refile-keep'
+being set to `t' and copy to the target location, don't move it.
+Beware that keeping refiled entries may result in duplicated ID
+properties.
RFLOC can be a refile location obtained in a different way.
+MSG is a string to replace \"Refile\" in the default prompt with
+another verb. E.g. `org-copy' sets this parameter to \"Copy\".
+
See also `org-refile-use-outline-path' and `org-completion-use-ido'.
If you are using target caching (see `org-refile-use-cache'),
@@ -10834,12 +11531,13 @@ 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))
+ (let* ((actionmsg (or msg "Refile"))
+ (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)))
+ (org-refile-keep (if (equal goto 3) t org-refile-keep))
pos it nbuf file re level reversed)
(setq last-command nil)
(when regionp
@@ -10849,8 +11547,10 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(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)")))
+ (let ((s (point-at-eol)))
+ (org-toggle-heading)
+ (setq region-end (+ (- (point-at-eol) s) region-end)))))
+ (user-error "The region is not a (sequence of) subtree(s)")))
(if (equal goto '(16))
(org-refile-goto-last-stored)
(when (or
@@ -10870,10 +11570,11 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(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 \""
+ (regionp (concat actionmsg " region to"))
+ (t (concat actionmsg " subtree \""
heading-text "\" to")))
default-buffer
(and (not (equal '(4) goto))
@@ -10895,7 +11596,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(setq nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
- (if goto
+ (if (and goto (not (equal goto 3)))
(progn
(org-pop-to-buffer-same-window nbuf)
(goto-char pos)
@@ -10930,30 +11631,38 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(if (not (bolp)) (newline))
(org-paste-subtree level)
(when org-log-refile
- (org-add-log-setup 'refile nil nil 'findpos
- 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)))
- (with-demoted-errors
- (bookmark-set "org-refile-last-stored"))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-refile)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
;; 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)
- (with-demoted-errors
- (bookmark-set "org-capture-last-stored-marker"))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture-marker)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
(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))
+ (unless org-refile-keep
+ (if regionp
+ (delete-region (point) (+ (point) (- region-end region-start)))
+ (delete-region
+ (and (org-back-to-heading t) (point))
+ (min (buffer-size) (org-end-of-subtree t t) (point)))))
(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)))))))
+ (message (concat actionmsg " to \"%s\" in file %s: done") (car it) file)))))))
(defun org-refile-goto-last-stored ()
"Go to the location where the last refile was stored."
@@ -10982,12 +11691,8 @@ this is used for the GOTO interface."
(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))
+ (user-error "No refile targets"))
+ (let* ((cbuf (current-buffer))
(partial-completion-mode nil)
(cfn (buffer-file-name (buffer-base-buffer cbuf)))
(cfunc (if (and org-refile-use-outline-path
@@ -10995,6 +11700,7 @@ this is used for the GOTO interface."
'org-olpath-completing-read
'org-icompleting-read))
(extra (if org-refile-use-outline-path "/" ""))
+ (cbnex (concat (buffer-name) extra))
(filename (and cfn (expand-file-name cfn)))
(tbl (mapcar
(lambda (x)
@@ -11007,10 +11713,16 @@ this is used for the GOTO interface."
(cons (concat (car x) extra) (cdr x))))
org-refile-target-table))
(completion-ignore-case t)
+ cdef
+ (prompt (concat prompt
+ (or (and (car org-refile-history)
+ (concat " (default " (car org-refile-history) ")"))
+ (and (assoc cbnex tbl) (setq cdef cbnex)
+ (concat " (default " cbnex ")"))) ": "))
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)))
+ nil 'org-refile-history (or cdef (car org-refile-history))))
(setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
(org-refile-check-position pa)
(if pa
@@ -11037,7 +11749,7 @@ this is used for the GOTO interface."
(y-or-n-p (format "Create new node \"%s\"? "
child)))))
(org-refile-new-child parent-target child)))
- (error "Invalid target location")))))
+ (user-error "Invalid target location")))))
(declare-function org-string-nw-p "org-macs" (s))
(defun org-refile-check-position (refile-pointer)
@@ -11047,7 +11759,7 @@ this is used for the GOTO interface."
(pos (nth 3 refile-pointer))
buffer)
(if (and (not (markerp pos)) (not file))
- (error "Please save the buffer to a file before refiling")
+ (user-error "Please save the buffer to a file before refiling")
(when (org-string-nw-p re)
(setq buffer (if (markerp pos)
(marker-buffer pos)
@@ -11060,7 +11772,7 @@ this is used for the GOTO interface."
(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")))))))))
+ (user-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."
@@ -11161,7 +11873,7 @@ PLIST must contain a :name entry which is used as name of the block."
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"))
+ (user-error "Not at a dynamic block"))
(let* ((begdel (1+ (match-end 0)))
(name (org-no-properties (match-string 1)))
(params (append (list :name name)
@@ -11260,75 +11972,45 @@ This function can be used in a hook."
;;;; 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:" "INDEX:"
- "BIND:"
- "MACRO:"))
+(declare-function org-export-backend-name "org-export" (cl-x))
+(declare-function org-export-backend-options "org-export" (cl-x))
+(defun org-get-export-keywords ()
+ "Return a list of all currently understood export keywords.
+Export keywords include options, block names, attributes and
+keywords relative to each registered export back-end."
+ (let (keywords)
+ (dolist (backend
+ (org-bound-and-true-p org-export--registered-backends)
+ (delq nil keywords))
+ ;; Back-end name (for keywords, like #+LATEX:)
+ (push (upcase (symbol-name (org-export-backend-name backend))) keywords)
+ (dolist (option-entry (org-export-backend-options backend))
+ ;; Back-end options.
+ (push (nth 1 option-entry) keywords)))))
(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)))
+ '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:"
+ "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:"
+ "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:"
+ "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:"
+ "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
(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>")
- ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM"
- "<verbatim>\n?\n</verbatim>")
- ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER"
- "<center>\n?\n</center>")
+ '(("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>")
+ ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" "<verbatim>\n?\n</verbatim>")
+ ("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>")
+ ("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: ?")
+ ("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.
@@ -11343,9 +12025,10 @@ 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")))
+ (list
+ (string :tag "Key")
+ (string :tag "Template")
+ (string :tag "Muse Template"))))
(defun org-try-structure-completion ()
"Try to complete a structure template before point.
@@ -11429,10 +12112,12 @@ nil or a string to be used for the todo mark." )
(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)))
+ (cond
+ (org-use-last-clock-out-time-as-effective-time
+ (or (org-clock-get-last-clock-out-time) ct))
+ ((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)))
+ (t ct))))
ct1))
(defun org-todo-yesterday (&optional arg)
@@ -11445,6 +12130,9 @@ nil or a string to be used for the todo mark." )
(org-extend-today-until (1+ hour)))
(org-todo arg))))
+(defvar org-block-entry-blocking ""
+ "First entry preventing the TODO state change.")
+
(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,
@@ -11536,8 +12224,7 @@ For calling through lisp, arg is also interpreted in the following way:
(not org-todo-key-trigger)))
;; Read a state with completion
(org-icompleting-read
- "State: " (mapcar (lambda(x) (list x))
- org-todo-keywords-1)
+ "State: " (mapcar 'list org-todo-keywords-1)
nil t))
((eq arg 'right)
(if this
@@ -11568,7 +12255,7 @@ For calling through lisp, arg is also interpreted in the following way:
(car org-todo-heads))))
((car (member arg org-todo-keywords-1)))
((stringp arg)
- (error "State `%s' not valid in this file" arg))
+ (user-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)))
@@ -11599,9 +12286,11 @@ For calling through lisp, arg is also interpreted in the following way:
(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)
+ (user-error "TODO state change from %s to %s blocked (by \"%s\")"
+ this org-state org-block-entry-blocking)
;; fail silently
- (message "TODO state change from %s to %s blocked" this org-state)
+ (message "TODO state change from %s to %s blocked (by \"%s\")"
+ this org-state org-block-entry-blocking)
(throw 'exit nil))))
(store-match-data match-data)
(replace-match next t t)
@@ -11632,9 +12321,10 @@ For calling through lisp, arg is also interpreted in the following way:
(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)))
+ (when (or (and (not org-state) (not org-closed-keep-when-no-todo))
+ (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))
@@ -11715,7 +12405,8 @@ changes. Such blocking occurs when:
;; completed
(if (and (not (org-entry-is-done-p))
(org-entry-is-todo-p))
- (throw 'dont-block nil))
+ (progn (setq org-block-entry-blocking (org-get-heading))
+ (throw 'dont-block nil)))
(outline-next-heading)
(setq child-level (funcall outline-level))))))
;; Otherwise, if the task's parent has the :ORDERED: property, and
@@ -11728,6 +12419,7 @@ changes. Such blocking occurs when:
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
(forward-line 1)
(re-search-forward org-not-done-heading-regexp pos t))
+ (setq org-block-entry-blocking (match-string 0))
(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
@@ -11739,7 +12431,8 @@ changes. Such blocking occurs when:
(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))
+ (re-search-forward org-not-done-heading-regexp pos t)
+ (setq org-block-entry-blocking (org-get-heading)))
(throw 'dont-block nil)))))))) ; block, older sibling not done.
(defcustom org-track-ordered-property-with-tag nil
@@ -11772,7 +12465,7 @@ See variable `org-track-ordered-property-with-tag'."
(org-back-to-heading)
(if (org-entry-get nil "ORDERED")
(progn
- (org-delete-property "ORDERED")
+ (org-delete-property "ORDERED" "PROPERTIES")
(and tag (org-toggle-tag tag 'off))
(message "Subtasks can be completed in arbitrary order"))
(org-entry-put nil "ORDERED" "t")
@@ -11816,16 +12509,15 @@ changes because there are unchecked boxes in this entry."
(defun org-entry-blocked-p ()
"Is the current entry blocked?"
- (org-with-buffer-modified-unmodified
+ (org-with-silent-modifications
(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))))))
+ (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.
@@ -12088,6 +12780,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(member (org-get-todo-state) org-done-keywords))
(defun org-get-todo-state ()
+ "Return the TODO keyword of the current subtree."
(save-excursion
(org-back-to-heading t)
(and (looking-at org-todo-line-regexp)
@@ -12180,7 +12873,7 @@ This function is run automatically after each state change to a DONE state."
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))
+ (user-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)))
@@ -12207,7 +12900,7 @@ This function is run automatically after each state change to a DONE state."
(org-at-timestamp-p t)
(setq ts (match-string 1))
(string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))))
- (org-timestamp-change n (cdr (assoc what whata)))
+ (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t))
(setq msg (concat msg type " " org-last-changed-timestamp " "))))
(setq org-log-post-message msg)
(message "%s" msg))))
@@ -12232,13 +12925,14 @@ of `org-todo-keywords-1'."
((<= (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)))))
+ (t (user-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)
+(defun org-deadline (arg &optional time)
"Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
-With argument REMOVE, remove any deadline from the item.
+With one universal prefix argument, remove any deadline from the item.
+With two universal prefix arguments, prompt for a warning delay.
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")
@@ -12247,22 +12941,43 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
'region-start-level 'region))
org-loop-over-headlines-in-active-region)
(org-map-entries
- `(org-deadline ',remove ,time)
+ `(org-deadline ',arg ,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"))
+ (old-date-time (if old-date (org-time-string-to-time old-date)))
(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."))
+ (cond
+ ((equal arg '(4))
+ (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."))
+ ((equal arg '(16))
+ (save-excursion
+ (org-back-to-heading t)
+ (if (re-search-forward
+ org-deadline-time-regexp
+ (save-excursion (outline-next-heading) (point)) t)
+ (let* ((rpl0 (match-string 1))
+ (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)))
+ (replace-match
+ (concat org-deadline-string
+ " <" rpl
+ (format " -%dd"
+ (abs
+ (- (time-to-days
+ (save-match-data
+ (org-read-date nil t nil "Warn starting from" old-date-time)))
+ (time-to-days old-date-time))))
+ ">") t t))
+ (user-error "No deadline information to update"))))
+ (t
(org-add-planning-info 'deadline time 'closed)
(when (and old-date org-log-redeadline
(not (equal old-date
@@ -12282,11 +12997,12 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater
(substring org-last-inserted-timestamp -1))))))
- (message "Deadline on %s" org-last-inserted-timestamp)))))
+ (message "Deadline on %s" org-last-inserted-timestamp))))))
-(defun org-schedule (&optional remove time)
+(defun org-schedule (arg &optional time)
"Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
-With argument REMOVE, remove any scheduling date from the item.
+With one universal prefix argument, remove any scheduling date from the item.
+With two universal prefix arguments, prompt for a delay cookie.
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")
@@ -12295,22 +13011,44 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
'region-start-level 'region))
org-loop-over-headlines-in-active-region)
(org-map-entries
- `(org-schedule ',remove ,time)
+ `(org-schedule ',arg ,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"))
+ (old-date-time (if old-date (org-time-string-to-time old-date)))
(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."))
+ (cond
+ ((equal arg '(4))
+ (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.")))
+ ((equal arg '(16))
+ (save-excursion
+ (org-back-to-heading t)
+ (if (re-search-forward
+ org-scheduled-time-regexp
+ (save-excursion (outline-next-heading) (point)) t)
+ (let* ((rpl0 (match-string 1))
+ (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)))
+ (replace-match
+ (concat org-scheduled-string
+ " <" rpl
+ (format " -%dd"
+ (abs
+ (- (time-to-days
+ (save-match-data
+ (org-read-date nil t nil "Delay until" old-date-time)))
+ (time-to-days old-date-time))))
+ ">") t t))
+ (user-error "No scheduled information to update"))))
+ (t
(org-add-planning-info 'scheduled time 'closed)
(when (and old-date org-log-reschedule
(not (equal old-date
@@ -12330,7 +13068,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater
(substring org-last-inserted-timestamp -1))))))
- (message "Scheduled to %s" org-last-inserted-timestamp)))))
+ (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
@@ -12578,7 +13316,7 @@ EXTRA is additional text that will be inserted into the notes buffer."
(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 (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"
@@ -12609,10 +13347,10 @@ EXTRA is additional text that will be inserted into the notes buffer."
(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)
+ (let ((txt (buffer-string)))
(kill-buffer (current-buffer))
+ (let ((note (cdr (assq org-log-note-purpose org-log-note-headings)))
+ lines ind bul)
(while (string-match "\\`# .*\n[ \t\n]*" txt)
(setq txt (replace-match "" t t txt)))
(if (string-match "\\s-+\\'" txt)
@@ -12679,12 +13417,19 @@ EXTRA is additional text that will be inserted into the notes buffer."
(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)))
+ (org-cycle-hide-drawers 'children))
+ ;; Fix `buffer-undo-list' when `org-store-log-note' is called
+ ;; from within `org-add-log-note' because `buffer-undo-list'
+ ;; is then modified outside of `org-with-remote-undo'.
+ (when (eq this-command 'org-agenda-todo)
+ (setcdr buffer-undo-list (cddr buffer-undo-list)))))))
+ ;; Don't add undo information when called from `org-agenda-todo'
+ (let ((buffer-undo-list (eq this-command 'org-agenda-todo)))
+ (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.
@@ -12725,11 +13470,14 @@ D Show deadlines and scheduled items between a date range."
((eq type 'active) "only active timestamps")
((eq type 'inactive) "only inactive timestamps")
((eq type 'scheduled-or-deadline) "scheduled/deadline")
+ ((eq type 'closed) "with a closed time-stamp")
(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)))))
+ (org-sparse-tree
+ arg (cadr (member type '(scheduled-or-deadline
+ all scheduled deadline active inactive closed)))))
((equal ans ?d)
(call-interactively 'org-check-deadlines))
((equal ans ?b)
@@ -12754,7 +13502,7 @@ D Show deadlines and scheduled items between a date range."
(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)))))
+ (t (user-error "No such sparse tree command \"%c\"" ans)))))
(defvar org-occur-highlights nil
"List of overlays used for occur matches.")
@@ -12783,7 +13531,7 @@ 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"))
+ (user-error "Regexp cannot be empty"))
(unless keep-previous
(org-remove-occur-highlights nil nil t))
(push (cons regexp callback) org-occur-parameters)
@@ -12867,7 +13615,7 @@ How much context is shown depends upon the variables
(not (bobp)))
(org-flag-heading nil)
(when siblings-p (org-show-siblings)))))
- (org-fix-ellipsis-at-bol)))
+ (unless (eq key 'agenda) (org-fix-ellipsis-at-bol))))
(defvar org-reveal-start-hook nil
"Hook run before revealing a location.")
@@ -12940,7 +13688,7 @@ ACTION can be `set', `up', `down', or a character."
(if (equal action '(4))
(org-show-priority)
(unless org-enable-priority-commands
- (error "Priority commands are disabled"))
+ (user-error "Priority commands are disabled"))
(setq action (or action 'set))
(let (current new news have remove)
(save-excursion
@@ -12964,7 +13712,7 @@ ACTION can be `set', `up', `down', or a character."
(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'"
+ (user-error "Priority must be between `%c' and `%c'"
org-highest-priority org-lowest-priority))))
((eq action 'up)
(setq new (if have
@@ -12986,7 +13734,7 @@ ACTION can be `set', `up', `down', or a character."
(if org-priority-start-cycle-with-default
org-default-priority
(1+ org-default-priority))))))
- (t (error "Invalid action")))
+ (t (user-error "Invalid action")))
(if (or (< (upcase new) org-highest-priority)
(> (upcase new) org-lowest-priority))
(if (and (memq action '(up down))
@@ -13003,7 +13751,7 @@ ACTION can be `set', `up', `down', or a character."
(replace-match "" t t nil 1)
(replace-match news t t nil 2))
(if remove
- (error "No priority cookie found in line")
+ (user-error "No priority cookie found in line")
(let ((case-fold-search nil))
(looking-at org-todo-line-regexp))
(if (match-end 2)
@@ -13062,7 +13810,7 @@ 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.
+ "Sca 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
@@ -13098,7 +13846,6 @@ headlines matching this string."
(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)))
@@ -13111,13 +13858,14 @@ headlines matching this string."
(when (eq action 'sparse-tree)
(org-overview)
(org-remove-occur-highlights))
- (while (re-search-forward re nil t)
+ (while (let (case-fold-search)
+ (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))
+ (setq level (org-reduced-level (org-outline-level))
category (org-get-category))
(setq i llast llast level)
;; remove tag lists from same and sublevels
@@ -13182,7 +13930,7 @@ headlines matching this string."
(if (eq org-tags-match-list-sublevels 'indented)
(make-string (1- level) ?.) "")
(org-get-heading))
- category
+ level category
tags-list)
priority (org-get-priority txt))
(goto-char lspos)
@@ -13197,7 +13945,7 @@ headlines matching this string."
(save-excursion
(setq rtn1 (funcall action))
(push rtn1 rtn)))
- (t (error "Invalid action")))
+ (t (user-error "Invalid action")))
;; if we are to skip sublevels, jump to end of subtree
(unless org-tags-match-list-sublevels
@@ -13300,11 +14048,14 @@ 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"))
+ (error "`org-make-tags-matcher' expects todo-only to be scoped in"))
(unless match
- ;; Get a new match request, with completion
+ ;; Get a new match request, with completion against the global
+ ;; tags table and the local tags in current buffer
(let ((org-last-tags-completion-table
- (org-global-tags-completion-table)))
+ (org-uniquify
+ (delq nil (append (org-get-buffer-tags)
+ (org-global-tags-completion-table))))))
(setq match (org-completing-read-no-i
"Match: " 'org-tags-completion-function nil nil nil
'org-tags-history))))
@@ -13315,8 +14066,19 @@ See also `org-scan-tags'.
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)
+ prop-p pn pv po gv rest (start 0) (ss 0))
+ ;; Expand group tags
+ (setq match (org-tags-expand match))
+
+ ;; Check if there is a TODO part of this match, which would be the
+ ;; part after a "/". TO make sure that this slash is not part of
+ ;; a property value to be matched against, we also check that there
+ ;; is no " after that slash.
+ ;; First, find the last slash
+ (while (string-match "/+" match ss)
+ (setq start (match-beginning 0) ss (match-end 0)))
+ (if (and (string-match "/+" match start)
+ (not (save-match-data (string-match "\"" match start))))
;; match contains also a todo-matching request
(progn
(setq tagsmatch (substring match 0 (match-beginning 0))
@@ -13422,6 +14184,62 @@ See also `org-scan-tags'.
matcher)))
(cons match0 matcher)))
+(defun org-tags-expand (match &optional single-as-list downcased)
+ "Expand group tags in MATCH.
+
+This replaces every group tag in MATCH with a regexp tag search.
+For example, a group tag \"Work\" defined as { Work : Lab Conf }
+will be replaced like this:
+
+ Work => {\\(?:Work\\|Lab\\|Conf\\)}
+ +Work => +{\\(?:Work\\|Lab\\|Conf\\)}
+ -Work => -{\\(?:Work\\|Lab\\|Conf\\)}
+
+Replacing by a regexp preserves the structure of the match.
+E.g., this expansion
+
+ Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home
+
+will match anything tagged with \"Lab\" and \"Home\", or tagged
+with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\".
+
+When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
+assumed to be a single group tag, and the function will return
+the list of tags in this group.
+
+When DOWNCASE is non-nil, expand downcased TAGS."
+ (if org-group-tags
+ (let* ((case-fold-search t)
+ (stable org-mode-syntax-table)
+ (tal (or org-tag-groups-alist-for-agenda
+ org-tag-groups-alist))
+ (tal (if downcased
+ (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
+ (tml (mapcar 'car tal))
+ (rtnmatch match) rpl)
+ ;; @ and _ are allowed as word-components in tags
+ (modify-syntax-entry ?@ "w" stable)
+ (modify-syntax-entry ?_ "w" stable)
+ (while (and tml
+ (with-syntax-table stable
+ (string-match
+ (concat "\\(?1:[+-]?\\)\\(?2:\\<"
+ (regexp-opt tml) "\\>\\)") rtnmatch)))
+ (let* ((dir (match-string 1 rtnmatch))
+ (tag (match-string 2 rtnmatch))
+ (tag (if downcased (downcase tag) tag)))
+ (setq tml (delete tag tml))
+ (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch)))
+ (setq rpl (append (org-uniquify rpl) (assoc tag tal)))
+ (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}"))
+ (if (stringp rpl) (org-add-props rpl '(grouptag t)))
+ (setq rtnmatch (replace-match rpl t t rtnmatch)))))
+ (if single-as-list
+ (or (reverse rpl) (list rtnmatch))
+ rtnmatch))
+ (if single-as-list (list (if downcased (downcase match) match))
+ match)))
+
(defun org-op-to-function (op &optional stringp)
"Turn an operator into the appropriate function."
(setq op
@@ -13600,7 +14418,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
(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))
+ (org-move-to-column (min ncol col) t nil t))
(goto-char pos))))
(defun org-set-tags-command (&optional arg just-align)
@@ -13766,7 +14584,9 @@ This works in the agenda, and also in an org-mode buffer."
(list (region-beginning) (region-end)
(let ((org-last-tags-completion-table
(if (derived-mode-p 'org-mode)
- (org-get-buffer-tags)
+ (org-uniquify
+ (delq nil (append (org-get-buffer-tags)
+ (org-global-tags-completion-table))))
(org-global-tags-completion-table))))
(org-icompleting-read
"Tag: " 'org-tags-completion-function nil nil nil
@@ -13818,15 +14638,14 @@ This works in the agenda, and also in an org-mode buffer."
rtn)
((eq flag t)
;; all-completions
- (all-completions s2 ctable confirm)
- )
+ (all-completions s2 ctable confirm))
((eq flag 'lambda)
;; exact match?
- (assoc s2 ctable)))
- ))
+ (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 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 "")))
@@ -13842,6 +14661,7 @@ This works in the agenda, and also in an org-mode buffer."
(insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
(defun org-set-current-tags-overlay (current prefix)
+ "Add an overlay to CURRENT tag with PREFIX."
(let ((s (concat ":" (mapconcat 'identity current ":") ":")))
(if (featurep 'xemacs)
(org-overlay-display org-tags-overlay (concat prefix s)
@@ -13924,6 +14744,7 @@ Returns the new tags string, or nil to not change the current settings."
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
+ ((equal e '(:grouptags)) nil)
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
@@ -13939,11 +14760,13 @@ Returns the new tags string, or nil to not change the current settings."
(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))))
+ (cond
+ ((not (assoc tg table))
+ (org-get-todo-face tg))
+ ((member tg current) c-face)
+ ((member tg inherited) i-face))))
+ (if (equal (caar tbl) :grouptags)
+ (org-add-props tg nil 'face 'org-tag-group))
(if (and (= cnt 0) (not ingroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
@@ -14045,7 +14868,7 @@ Returns the new tags string, or nil to not change the current settings."
(defun org-get-tags-string ()
"Get the TAGS string in the current headline."
(unless (org-at-heading-p t)
- (error "Not on a heading"))
+ (user-error "Not on a heading"))
(save-excursion
(beginning-of-line 1)
(if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
@@ -14153,7 +14976,7 @@ a *different* entry, you cannot use these techniques."
((eq match nil) (setq matcher t))
(t (setq matcher (if match (cdr (org-make-tags-matcher match)) t))))
- (save-excursion
+ (save-window-excursion
(save-restriction
(cond ((eq scope 'tree)
(org-back-to-heading t)
@@ -14248,16 +15071,6 @@ Being in this list makes sure that they are offered for completion.")
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)
@@ -14274,13 +15087,15 @@ value for the property."
(call-interactively 'org-delete-property-globally))
((equal c ?c)
(call-interactively 'org-compute-property-at-point))
- (t (error "No such property action %c" c)))))
+ (t (user-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))
+(defvar org-clock-effort) ;; Defined in org-clock.el
+(defvar org-clock-current-task) ;; Defined in org-clock.el
(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
@@ -14294,6 +15109,7 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(cur (org-entry-get nil prop))
(allowed (org-property-get-allowed-values nil prop 'table))
(existing (mapcar 'list (org-property-values prop)))
+ (heading (nth 4 (org-heading-components)))
rpl
(val (cond
((stringp value) value)
@@ -14302,7 +15118,7 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(car (org-last allowed))))
((and allowed increment)
(or (caadr (member (list cur) allowed))
- (error "Allowed effort values are not set")))
+ (user-error "Allowed effort values are not set")))
(allowed
(message "Select 1-9,0, [RET%s]: %s"
(if cur (concat "=" cur) "")
@@ -14327,18 +15143,17 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(save-excursion
(org-back-to-heading t)
(put-text-property (point-at-bol) (point-at-eol) 'org-effort val))
+ (when (string= heading org-clock-current-task)
+ (setq org-clock-effort (get-text-property (point-at-bol) 'org-effort))
+ (org-clock-update-mode-line))
(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))))))))
+ (when (equal 'node-property (car (org-element-at-point)))
+ (beginning-of-line 1)
+ (looking-at org-property-re))))
(defun org-get-property-block (&optional beg end force)
"Return the (beg . end) range of the body of the property drawer.
@@ -14463,11 +15278,10 @@ things up because then unnecessary parsing is avoided."
(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-.*\\)?")
+ (while (re-search-forward org-property-re
(cdr range) t)
- (setq key (org-match-string-no-properties 1)
- value (org-trim (or (org-match-string-no-properties 2) "")))
+ (setq key (org-match-string-no-properties 2)
+ value (org-trim (or (org-match-string-no-properties 3) "")))
(unless (member key excluded)
(push (cons key (or value "")) props)))))
(if clocksum
@@ -14516,8 +15330,8 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
(setq props
(org-update-property-plist
key
- (if (match-end 1)
- (org-match-string-no-properties 1) "")
+ (if (match-end 3)
+ (org-match-string-no-properties 3) "")
props)))))
val)
(goto-char (car range))
@@ -14535,8 +15349,10 @@ If yes, return this value. If not, return the current value of the variable."
(read prop)
(symbol-value var))))
-(defun org-entry-delete (pom property)
- "Delete the property PROPERTY from entry at point-or-marker POM."
+(defun org-entry-delete (pom property &optional delete-empty-drawer)
+ "Delete the property PROPERTY from entry at point-or-marker POM.
+When optional argument DELETE-EMPTY-DRAWER is a string, it defines
+an empty drawer to delete."
(org-with-point-at pom
(if (member property org-special-properties)
nil ; cannot delete these properties.
@@ -14548,6 +15364,9 @@ If yes, return this value. If not, return the current value of the variable."
(cdr range) t))
(progn
(delete-region (match-beginning 0) (1+ (point-at-eol)))
+ (and delete-empty-drawer
+ (org-remove-empty-drawer-at
+ delete-empty-drawer (car range)))
t)
nil)))))
@@ -14559,7 +15378,7 @@ If yes, return this value. If not, return the current value of the variable."
(values (and old (org-split-string old "[ \t]"))))
(setq value (org-entry-protect-space value))
(unless (member value values)
- (setq values (cons value values))
+ (setq values (append values (list value)))
(org-entry-put pom property
(mapconcat 'identity values " ")))))
@@ -14660,7 +15479,7 @@ and the new value.")
((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))
+ (user-error "\"%s\" is not a valid TODO state" value))
(if (or (not value)
(not (string-match "\\S-" value)))
(setq value 'none))
@@ -14670,6 +15489,15 @@ and the new value.")
(org-priority (if (and value (stringp value) (string-match "\\S-" value))
(string-to-char value) ?\ ))
(org-set-tags nil 'align))
+ ((equal property "CLOCKSUM")
+ (if (not (re-search-forward
+ (concat org-clock-string ".*\\]--\\(\\[[^]]+\\]\\)") nil t))
+ (error "Cannot find a clock log")
+ (goto-char (- (match-end 1) 2))
+ (cond
+ ((eq value 'earlier) (org-timestamp-down))
+ ((eq value 'later) (org-timestamp-up)))
+ (org-clock-sum-current-item)))
((equal property "SCHEDULED")
(if (re-search-forward org-scheduled-time-regexp end t)
(cond
@@ -14692,7 +15520,7 @@ and the new value.")
(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)
+ (org-re-property property) (cdr range) t)
(progn
(delete-region (match-beginning 0) (match-end 0))
(goto-char (match-beginning 0)))
@@ -14722,10 +15550,9 @@ formats in the current buffer."
(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:]_]+\\):")
+ (while (re-search-forward org-property-re
(cdr range) t)
- (add-to-list 'rtn (org-match-string-no-properties 1)))
+ (add-to-list 'rtn (org-match-string-no-properties 2)))
(outline-next-heading))))
(when include-specials
@@ -14763,7 +15590,7 @@ formats in the current buffer."
(let ((re (org-re-property key))
values)
(while (re-search-forward re nil t)
- (add-to-list 'values (org-trim (match-string 1))))
+ (add-to-list 'values (org-trim (match-string 3))))
(delete "" values)))))
(defun org-insert-property-drawer ()
@@ -14792,7 +15619,9 @@ formats in the current buffer."
(beginning-of-line 1)))
(org-skip-over-state-notes)
(skip-chars-backward " \t\n\r")
- (if (eq (char-before) ?*) (forward-char 1))
+ (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n)))
+ (forward-char 1))
+ (goto-char (point-at-eol))
(let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
(beginning-of-line 0)
(org-indent-to-column indent)
@@ -14849,7 +15678,7 @@ Point is left between drawer's boundaries."
(beginning-of-line)
(when (save-excursion
(re-search-forward org-outline-regexp-bol rend t))
- (error "Drawers cannot contain headlines"))
+ (user-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.
@@ -14907,6 +15736,7 @@ This is computed according to `org-property-set-functions-alist'."
val)))
(defvar org-last-set-property nil)
+(defvar org-last-set-property-value nil)
(defun org-read-property-name ()
"Read a property name."
(let* ((completion-ignore-case t)
@@ -14924,8 +15754,7 @@ This is computed according to `org-property-set-functions-alist'."
": ")
(mapcar 'list keys)
nil nil nil nil
- default-prop
- )))
+ default-prop)))
(if (member property keys)
property
(or (cdr (assoc (downcase property)
@@ -14933,6 +15762,23 @@ This is computed according to `org-property-set-functions-alist'."
keys)))
property))))
+(defun org-set-property-and-value (use-last)
+ "Allow to set [PROPERTY]: [value] direction from prompt.
+When use-default, don't even ask, just use the last
+\"[PROPERTY]: [value]\" string from the history."
+ (interactive "P")
+ (let* ((completion-ignore-case t)
+ (pv (or (and use-last org-last-set-property-value)
+ (org-completing-read
+ "Enter a \"[Property]: [value]\" pair: "
+ nil nil nil nil nil
+ org-last-set-property-value)))
+ prop val)
+ (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv)
+ (setq prop (match-string 1 pv)
+ val (match-string 2 pv))
+ (org-set-property prop val))))
+
(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
@@ -14945,20 +15791,23 @@ in the current file."
(value (or value (org-read-property-value property)))
(fn (cdr (assoc property org-properties-postprocess-alist))))
(setq org-last-set-property property)
+ (setq org-last-set-property-value (concat property ": " value))
;; 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."
+(defun org-delete-property (property &optional delete-empty-drawer)
+ "In the current entry, delete PROPERTY.
+When optional argument DELETE-EMPTY-DRAWER is a string, it defines
+an empty drawer to delete."
(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)
+ (if (org-entry-delete nil property delete-empty-drawer)
"deleted"
"was not present in the entry")))
@@ -14990,11 +15839,11 @@ 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"))
+ (user-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))
+ (user-error "No operator defined for property %s" prop))
(org-columns-compute prop)))
(defvar org-property-allowed-value-functions nil
@@ -15047,22 +15896,23 @@ completion."
"Switch to the next allowed value for this property."
(interactive)
(unless (org-at-property-p)
- (error "Not at a property"))
+ (user-error "Not at a property"))
(let* ((prop (car (save-match-data (org-split-string (match-string 1) ":"))))
(key (match-string 2))
(value (match-string 3))
(allowed (or (org-property-get-allowed-values (point) key)
(and (member value '("[ ]" "[-]" "[X]"))
'("[ ]" "[X]"))))
+ (heading (save-match-data (nth 4 (org-heading-components))))
nval)
(unless allowed
- (error "Allowed values for this property have not been defined"))
+ (user-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"))
+ (user-error "Only one allowed value for this property"))
(org-at-property-p)
(replace-match (concat " :" key ": " nval) t t)
(org-indent-line)
@@ -15071,7 +15921,10 @@ completion."
(when (equal prop org-effort-property)
(save-excursion
(org-back-to-heading t)
- (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval)))
+ (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval))
+ (when (string= org-clock-current-task heading)
+ (setq org-clock-effort nval)
+ (org-clock-update-mode-line)))
(run-hook-with-args 'org-property-changed-functions key nval)))
(defun org-find-olp (path &optional this-buffer)
@@ -15201,7 +16054,10 @@ 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."
+with the current time without prompting the user.
+
+When called from lisp, the timestamp is inactive if INACTIVE is
+non-nil."
(interactive "P")
(let* ((ts nil)
(default-time
@@ -15248,7 +16104,7 @@ with the current time without prompting the user."
" " repeater ">"))))
(message "Timestamp updated"))
((equal arg '(16))
- (org-insert-time-stamp (current-time) t))
+ (org-insert-time-stamp (current-time) t inactive))
(t
(setq time (let ((this-command this-command))
(org-read-date arg 'totime nil nil default-time default-input inactive)))
@@ -15270,7 +16126,7 @@ with the current time without prompting the user."
(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))))))))
+ (and (/= 0 dm) (format ":%02d" dm)))))))
(defun org-time-stamp-inactive (&optional arg)
"Insert an inactive time stamp.
@@ -15299,6 +16155,76 @@ So these are more for recording a certain time/date."
(defvar org-read-date-analyze-forced-year nil)
(defvar org-read-date-inactive)
+(defvar org-read-date-minibuffer-local-map
+ (let* ((org-replace-disputed-keys nil)
+ (map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (org-defkey map (kbd ".")
+ (lambda () (interactive)
+ ;; Are we at the beginning of the prompt?
+ (if (looking-back "^[^:]+: ")
+ (org-eval-in-calendar '(calendar-goto-today))
+ (insert "."))))
+ (org-defkey map (kbd "C-.")
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-goto-today))))
+ (org-defkey map [(meta shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-month 1))))
+ (org-defkey map [(meta shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-month 1))))
+ (org-defkey map [(meta shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-year 1))))
+ (org-defkey map [(meta shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-year 1))))
+ (org-defkey map [?\e (shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-month 1))))
+ (org-defkey map [?\e (shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-month 1))))
+ (org-defkey map [?\e (shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-year 1))))
+ (org-defkey map [?\e (shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-year 1))))
+ (org-defkey map [(shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-week 1))))
+ (org-defkey map [(shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-week 1))))
+ (org-defkey map [(shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-day 1))))
+ (org-defkey map [(shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-day 1))))
+ (org-defkey map "!"
+ (lambda () (interactive)
+ (org-eval-in-calendar '(diary-view-entries))
+ (message "")))
+ (org-defkey map ">"
+ (lambda () (interactive)
+ (org-eval-in-calendar '(scroll-calendar-left 1))))
+ (org-defkey map "<"
+ (lambda () (interactive)
+ (org-eval-in-calendar '(scroll-calendar-right 1))))
+ (org-defkey map "\C-v"
+ (lambda () (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-left-three-months 1))))
+ (org-defkey map "\M-v"
+ (lambda () (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-right-three-months 1))))
+ map)
+ "Keymap for minibuffer commands when using `org-read-date'.")
+
(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.
@@ -15319,7 +16245,8 @@ mean next year. For details, see the manual. A few examples:
12:45 --> today 12:45
22 sept 0:34 --> currentyear-09-22 0:34
12 --> currentyear-currentmonth-12
- Fri --> nearest Friday (today or later)
+ Fri --> nearest Friday after today
+ -Tue --> last Tuesday
etc.
Furthermore you can specify a relative date by giving, as the *first* thing
@@ -15391,61 +16318,11 @@ user."
(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)))
+ (minibuffer-local-map
+ (copy-keymap org-read-date-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)
@@ -15757,7 +16634,11 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to
(if wday1
(progn
(setq delta (mod (+ 7 (- wday1 wday)) 7))
- (if (= dir ?-) (setq delta (- delta 7)))
+ (if (= delta 0) (setq delta 7))
+ (if (= dir ?-)
+ (progn
+ (setq delta (- delta 7))
+ (if (= delta 0) (setq 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)))))
@@ -15913,32 +16794,44 @@ 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))))
+(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4")
+
+(defun org-time-stamp-to-now (timestamp-string &optional seconds)
+ "Difference between TIMESTAMP-STRING and now in days.
+If SECONDS is non-nil, return the difference in seconds."
+ (let ((fdiff (if seconds 'org-float-time 'time-to-days)))
+ (- (funcall fdiff (org-time-string-to-time timestamp-string))
+ (funcall fdiff (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)
+ (and (< (org-time-stamp-to-now 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)
- ("h" . 0.041667)))))))
- ;; go for the default.
- (t org-deadline-warning-days)))
+(defun org-get-wdays (ts &optional delay zero-delay)
+ "Get the deadline lead time appropriate for timestring TS.
+When DELAY is non-nil, get the delay time for scheduled items
+instead of the deadline lead time. When ZERO-DELAY is non-nil
+and `org-scheduled-delay-days' is 0, enforce 0 as the delay,
+don't try to find the delay cookie in the scheduled timestamp."
+ (let ((tv (if delay org-scheduled-delay-days
+ org-deadline-warning-days)))
+ (cond
+ ((or (and delay (< tv 0))
+ (and delay zero-delay (<= tv 0))
+ (and (not delay) (<= tv 0)))
+ ;; Enforce this value no matter what
+ (- tv))
+ ((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)
+ ("h" . 0.041667)))))))
+ ;; go for the default.
+ (t tv))))
(defun org-calendar-select-mouse (ev)
"Return to `org-read-date' with the date currently selected.
@@ -15981,6 +16874,7 @@ Allowed values for TYPE are:
inactive: only inactive timestamps ([...])
scheduled: only scheduled timestamps
deadline: only deadline timestamps
+ closed: only closed time-stamps
When TYPE is nil, fall back on returning a regexp that matches
both scheduled and deadline timestamps."
@@ -15989,6 +16883,7 @@ both scheduled and deadline timestamps."
((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 'closed) (concat org-closed-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]"))
((eq type 'scheduled-or-deadline)
(concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>"))))
@@ -16052,7 +16947,7 @@ days in order to avoid rounding problems."
(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")))
+ (user-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)))
@@ -16129,10 +17024,10 @@ days in order to avoid rounding problems."
(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.
+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."
+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)
@@ -16158,7 +17053,7 @@ The variable date is bound by the calendar when this is called."
(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.
+38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2037.
The year 2000 cannot be abbreviated. Any year larger than 99
is returned unchanged."
(if (< year 38)
@@ -16256,7 +17151,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp."
(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))
+ (user-error "Invalid change specifier: %s" change))
(if (eq dw 'week) (setq dw 'day dn (* 7 dn)))
(cond
((eq dw 'hour)
@@ -16323,17 +17218,19 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp."
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)))
+ (cond ((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))
+ ((string-match "^<[^>]+>$" s)
+ (decode-time (seconds-to-time (org-matcher-time s))))
+ (t (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.
@@ -16423,11 +17320,12 @@ With prefix ARG, change that many days."
(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)
+(defun org-timestamp-change (n &optional what updown suppress-tmp-delay)
"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."
+in the timestamp determines what will be changed.
+When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(let ((origin (point)) origin-cat
with-hm inactive
(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
@@ -16435,7 +17333,7 @@ in the timestamp determines what will be changed."
extra rem
ts time time0 fixnext clrgx)
(if (not (org-at-timestamp-p t))
- (error "Not at a timestamp"))
+ (user-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
@@ -16451,10 +17349,12 @@ in the timestamp determines what will be changed."
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)))
+ (when (string-match
+ "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
+ ts)
+ (setq extra (match-string 1 ts))
+ (if suppress-tmp-delay
+ (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
(if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
(setq with-hm t))
(setq time0 (org-parse-time-string ts))
@@ -16518,7 +17418,7 @@ in the timestamp determines what will be changed."
;; 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))
+ (< 1 (length (delq nil (mapcar 'marker-position
org-clock-history))))))
(message "No clock to adjust")
(cond ((save-excursion ; fix previous clock?
@@ -16637,27 +17537,6 @@ If there is already a time stamp at the cursor position, update it."
(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))
@@ -16679,7 +17558,146 @@ effort string \"2hours\" is equivalent to 120 minutes."
:type '(alist :key-type (string :tag "Modifier")
:value-type (number :tag "Minutes")))
-(defcustom org-agenda-inhibit-startup t
+(defun org-minutes-to-clocksum-string (m)
+ "Format number of minutes as a clocksum string.
+The format is determined by `org-time-clocksum-format',
+`org-time-clocksum-use-fractional' and
+`org-time-clocksum-fractional-format' and
+`org-time-clocksum-use-effort-durations'."
+ (let ((clocksum "")
+ (m (round m)) ; Don't allow fractions of minutes
+ h d w mo y fmt n)
+ (setq h (if org-time-clocksum-use-effort-durations
+ (cdr (assoc "h" org-effort-durations)) 60)
+ d (if org-time-clocksum-use-effort-durations
+ (/ (cdr (assoc "d" org-effort-durations)) h) 24)
+ w (if org-time-clocksum-use-effort-durations
+ (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7)
+ mo (if org-time-clocksum-use-effort-durations
+ (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30)
+ y (if org-time-clocksum-use-effort-durations
+ (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365))
+ ;; fractional format
+ (if org-time-clocksum-use-fractional
+ (cond
+ ;; single format string
+ ((stringp org-time-clocksum-fractional-format)
+ (format org-time-clocksum-fractional-format (/ m (float h))))
+ ;; choice of fractional formats for different time units
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years))
+ (> (/ (truncate m) (* y d h)) 0))
+ (format fmt (/ m (* y d (float h)))))
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months))
+ (> (/ (truncate m) (* mo d h)) 0))
+ (format fmt (/ m (* mo d (float h)))))
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
+ (> (/ (truncate m) (* w d h)) 0))
+ (format fmt (/ m (* w d (float h)))))
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days))
+ (> (/ (truncate m) (* d h)) 0))
+ (format fmt (/ m (* d (float h)))))
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours))
+ (> (/ (truncate m) h) 0))
+ (format fmt (/ m (float h))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes))
+ (format fmt m))
+ ;; fall back to smallest time unit with a format
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :hours))
+ (format fmt (/ m (float h))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :days))
+ (format fmt (/ m (* d (float h)))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
+ (format fmt (/ m (* w d (float h)))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :months))
+ (format fmt (/ m (* mo d (float h)))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :years))
+ (format fmt (/ m (* y d (float h))))))
+ ;; standard (non-fractional) format, with single format string
+ (if (stringp org-time-clocksum-format)
+ (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n)))
+ ;; separate formats components
+ (and (setq fmt (plist-get org-time-clocksum-format :years))
+ (or (> (setq n (/ (truncate m) (* y d h))) 0)
+ (plist-get org-time-clocksum-format :require-years))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n y d h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :months))
+ (or (> (setq n (/ (truncate m) (* mo d h))) 0)
+ (plist-get org-time-clocksum-format :require-months))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n mo d h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :weeks))
+ (or (> (setq n (/ (truncate m) (* w d h))) 0)
+ (plist-get org-time-clocksum-format :require-weeks))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n w d h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :days))
+ (or (> (setq n (/ (truncate m) (* d h))) 0)
+ (plist-get org-time-clocksum-format :require-days))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n d h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :hours))
+ (or (> (setq n (/ (truncate m) h)) 0)
+ (plist-get org-time-clocksum-format :require-hours))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :minutes))
+ (or (> m 0) (plist-get org-time-clocksum-format :require-minutes))
+ (setq clocksum (concat clocksum (format fmt m))))
+ ;; return formatted time duration
+ clocksum))))
+
+(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string)
+(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string
+ "Org mode version 8.0")
+
+(defun org-hours-to-clocksum-string (n)
+ (org-minutes-to-clocksum-string (* n 60)))
+
+(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-image-actual-width t
+ "Should we use the actual width of images when inlining them?
+
+When set to `t', always use the image width.
+
+When set to a number, use imagemagick (when available) to set
+the image's width to this value.
+
+When set to a number in a list, try to get the width from any
+#+ATTR.* keyword if it matches a width specification like
+
+ #+ATTR_HTML: :width 300px
+
+and fall back on that number if none is found.
+
+When set to nil, try to get the width from an #+ATTR.* keyword
+and fall back on the original width if none is found.
+
+This requires Emacs >= 24.1, build with imagemagick support."
+ :group 'org-appearance
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Use the image width" t)
+ (integer :tag "Use a number of pixels")
+ (list :tag "Use #+ATTR* or a number of pixels" (integer))
+ (const :tag "Use #+ATTR* or don't resize" nil)))
+
+(defcustom org-agenda-inhibit-startup nil
"Inhibit startup when preparing agenda buffers.
When this variable is `t' (the default), the initialization of
the Org agenda buffers is inhibited: e.g. the visibility state
@@ -16688,6 +17706,21 @@ is not set, the tables are not re-aligned, etc."
:version "24.3"
:group 'org-agenda)
+(defcustom org-agenda-ignore-drawer-properties nil
+ "Avoid updating text properties when building the agenda.
+Properties are used to prepare buffers for effort estimates, appointments,
+and subtree-local categories.
+If you don't use these in the agenda, you can add them to this list and
+agenda building will be a bit faster.
+The value is a list, with zero or more of the symbols `effort', `appt',
+or `category'."
+ :type '(set :greedy t
+ (const effort)
+ (const appt)
+ (const category))
+ :version "24.3"
+ :group 'org-agenda)
+
(defun org-duration-string-to-minutes (s &optional output-to-string)
"Convert a duration string S to minutes.
@@ -16733,7 +17766,7 @@ changes from another. I believe the procedure must be like this:
3. M-x org-revert-all-org-buffers"
(interactive)
(unless (yes-or-no-p "Revert all Org buffers from their files? ")
- (error "Abort"))
+ (user-error "Abort"))
(save-excursion
(save-window-excursion
(mapc
@@ -16923,7 +17956,7 @@ If the current buffer does not, find the first agenda file."
(files (append fs (list (car fs))))
(tcf (if buffer-file-name (file-truename buffer-file-name)))
file)
- (unless files (error "No agenda files"))
+ (unless files (user-error "No agenda files"))
(catch 'exit
(while (setq file (pop files))
(if (equal (file-truename file) tcf)
@@ -16945,7 +17978,7 @@ end of the list."
(org-agenda-files t)))
(ctf (file-truename
(or buffer-file-name
- (error "Please save the current buffer to a file"))))
+ (user-error "Please save the current buffer to a file"))))
x had)
(setq x (assoc ctf file-alist) had x)
@@ -16965,7 +17998,7 @@ 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
- (error "Current buffer does not visit a file")))
+ (user-error "Current buffer does not visit a file")))
(true-file (file-truename file))
(afile (abbreviate-file-name file))
(files (delq nil (mapcar
@@ -17029,8 +18062,10 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(inhibit-read-only t)
(org-inhibit-startup org-agenda-inhibit-startup)
(rea (concat ":" org-archive-tag ":"))
- bmp file re)
- (save-excursion
+ file re pos)
+ (setq org-tag-alist-for-agenda nil
+ org-tag-groups-alist-for-agenda nil)
+ (save-window-excursion
(save-restriction
(while (setq file (pop files))
(catch 'nextfile
@@ -17039,10 +18074,21 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(org-check-agenda-file file)
(set-buffer (org-get-agenda-file-buffer file)))
(widen)
- (setq bmp (buffer-modified-p))
- (org-refresh-category-properties)
- (org-refresh-properties org-effort-property 'org-effort)
- (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)
+ (org-set-regexps-and-options-for-tags)
+ (setq pos (point))
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (when (search-forward "#+setupfile" nil t)
+ ;; Don't set all regexps and options systematically as
+ ;; this is only run for setting agenda tags from setup
+ ;; file
+ (org-set-regexps-and-options)))
+ (or (memq 'category org-agenda-ignore-drawer-properties)
+ (org-refresh-category-properties))
+ (or (memq 'effort org-agenda-ignore-drawer-properties)
+ (org-refresh-properties org-effort-property 'org-effort))
+ (or (memq 'appt org-agenda-ignore-drawer-properties)
+ (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
(setq org-todo-keywords-for-agenda
(append org-todo-keywords-for-agenda org-todo-keywords-1))
(setq org-done-keywords-for-agenda
@@ -17052,29 +18098,36 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(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)))))
+ (org-uniquify
+ (append org-tag-alist-for-agenda
+ org-tag-alist
+ org-tag-persistent-alist)))
+ (if org-group-tags
+ (setq org-tag-groups-alist-for-agenda
+ (org-uniquify-alist
+ (append org-tag-groups-alist-for-agenda org-tag-groups-alist))))
+ (org-with-silent-modifications
+ (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))))
+ (goto-char pos)))))
(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))))
+ (org-uniquify org-todo-keyword-alist-for-agenda))))
-;;;; Embedded LaTeX
+
+;;;; CDLaTeX minor mode
(defvar org-cdlatex-mode-map (make-sparse-keymap)
"Keymap for the minor `org-cdlatex-mode'.")
@@ -17124,6 +18177,58 @@ an embedded LaTeX fragment, let texmathp do its job.
"Unconditionally turn on `org-cdlatex-mode'."
(org-cdlatex-mode 1))
+(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))))))
+
+
+
+;;;; LaTeX fragments
+
+(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.")
+
(defun org-inside-LaTeX-fragment-p ()
"Test if point is inside a LaTeX fragment.
I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
@@ -17174,43 +18279,6 @@ looks only before point, not after."
(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)
@@ -17232,51 +18300,40 @@ 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.")
+ (user-error "Can't preview LaTeX fragment in a non-file buffer"))
+ (when (display-graphic-p)
+ (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-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.
@@ -17287,12 +18344,11 @@ Some of the options can be changed using the variable
(absprefix (expand-file-name prefix dir))
(todir (file-name-directory absprefix))
(opt org-format-latex-options)
+ (optnew 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
+ string
m n block-type block linkfile movefile ov)
;; Check the different regular expressions
(while (setq e (pop re-list))
@@ -17302,71 +18358,58 @@ Some of the options can be changed using the variable
(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 'verbatim))
((eq processing-type 'mathjax)
- ;; Prepare for MathJax processing
+ ;; 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))))
+ (when (member m '("$" "$1"))
+ (save-excursion
+ (delete-region (match-beginning n) (match-end n))
+ (goto-char (match-beginning n))
+ (insert (concat "\\(" (substring string 1 -1) "\\)")))))
((or (eq processing-type 'dvipng)
(eq processing-type 'imagemagick))
- ;; Process to an image
+ ;; 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
+ (let ((face (face-at-point))
+ (fg (plist-get opt :foreground))
+ (bg (plist-get opt :background))
+ ;; Ensure full list is printed.
+ print-length print-level)
+ (when forbuffer
+ ;; Get the colors from the face at point.
+ (goto-char beg)
+ (when (eq fg 'auto)
+ (setq fg (face-attribute face :foreground nil 'default)))
+ (when (eq bg 'auto)
+ (setq bg (face-attribute face :background nil 'default)))
+ (setq optnew (copy-sequence opt))
+ (plist-put optnew :foreground fg)
+ (plist-put optnew :background bg))
(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-latex-default-packages-alist
+ org-latex-packages-alist
org-format-latex-options
- forbuffer txt)))
+ forbuffer txt fg bg)))
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
+ (unless checkdir ; Ensure 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))))
+ (unless (file-exists-p movefile)
+ (org-create-formula-image
+ txt movefile optnew forbuffer processing-type))
(if overlays
(progn
(mapc (lambda (o)
@@ -17396,10 +18439,8 @@ Some of the options can be changed using the variable
(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))
+ (unless (save-match-data (org-format-latex-mathml-available-p))
+ (user-error "LaTeX to MathML converter not configured"))
(setq txt (match-string n)
beg (match-beginning n) end (match-end n)
cnt (1+ cnt))
@@ -17409,7 +18450,7 @@ Some of the options can be changed using the variable
(insert (org-format-latex-as-mathml
txt block-type prefix dir)))
(t
- (error "Unknown conversion type %s for latex fragments"
+ (error "Unknown conversion type %s for LaTeX fragments"
processing-type)))))))))
(defun org-create-math-formula (latex-frag &optional mathml-file)
@@ -17425,7 +18466,7 @@ inspection."
(buffer-substring-no-properties
(region-beginning) (region-end)))))
(read-string "LaTeX Fragment: " frag nil frag))))
- (unless latex-frag (error "Invalid latex-frag"))
+ (unless latex-frag (error "Invalid LaTeX fragment"))
(let* ((tmp-in-file (file-relative-name
(make-temp-name (expand-file-name "ltxmathml-in"))))
(ignore (write-region latex-frag nil tmp-in-file))
@@ -17440,7 +18481,7 @@ inspection."
mathml shell-command-output)
(when (org-called-interactively-p 'any)
(unless (org-format-latex-mathml-available-p)
- (error "LaTeX to MathML converter not configured")))
+ (user-error "LaTeX to MathML converter not configured")))
(message "Running %s" cmd)
(setq shell-command-output (shell-command-to-string cmd))
(setq mathml
@@ -17497,14 +18538,57 @@ inspection."
'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)))
+(defun org-create-formula-image (string tofile options buffer &optional type)
+ "Create an image from LaTeX source using dvipng or convert.
+This function calls either `org-create-formula-image-with-dvipng'
+or `org-create-formula-image-with-imagemagick' depending on the
+value of `org-latex-create-formula-image-program' or on the value
+of the optional TYPE variable.
+
+Note: ultimately these two function should be combined as they
+share a good deal of logic."
+ (org-check-external-command
+ "latex" "needed to convert LaTeX fragments to images")
+ (funcall
+ (case (or type org-latex-create-formula-image-program)
+ ('dvipng
+ (org-check-external-command
+ "dvipng" "needed to convert LaTeX fragments to images")
+ #'org-create-formula-image-with-dvipng)
+ ('imagemagick
+ (org-check-external-command
+ "convert" "you need to install imagemagick")
+ #'org-create-formula-image-with-imagemagick)
+ (t (error
+ "Invalid value of `org-latex-create-formula-image-program'")))
+ string tofile options buffer))
+
+(declare-function org-export-get-backend "ox" (name))
+(declare-function org-export--get-global-options "ox" (&optional backend))
+(declare-function org-export--get-inbuffer-options "ox" (&optional backend))
+(declare-function org-latex-guess-inputenc "ox-latex" (header))
+(declare-function org-latex-guess-babel-language "ox-latex" (header info))
+(defun org-create-formula--latex-header ()
+ "Return LaTeX header appropriate for previewing a LaTeX snippet."
+ (let ((info (org-combine-plists (org-export--get-global-options
+ (org-export-get-backend 'latex))
+ (org-export--get-inbuffer-options
+ (org-export-get-backend 'latex)))))
+ (org-latex-guess-babel-language
+ (org-latex-guess-inputenc
+ (org-splice-latex-header
+ org-format-latex-header
+ org-latex-default-packages-alist
+ org-latex-packages-alist t
+ (plist-get info :latex-header)))
+ info)))
+
;; 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)
+ (require 'ox-latex)
(let* ((tmpdir (if (featurep 'xemacs)
(temp-directory)
temporary-file-directory))
@@ -17522,17 +18606,14 @@ inspection."
"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))
+ (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))
+ (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg))))
+ (if (eq bg 'default) (setq bg (org-dvipng-color :background))
+ (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg))))
+ (let ((latex-header (org-create-formula--latex-header)))
+ (with-temp-file texfile
+ (insert latex-header)
+ (insert "\n\\begin{document}\n" string "\n\\end{document}\n")))
(let ((dir default-directory))
(condition-case nil
(progn
@@ -17569,10 +18650,10 @@ inspection."
(delete-file (concat texfilebase e))))
pngfile))))
-(defvar org-latex-to-pdf-process) ;; Defined in org-latex.el
+(declare-function org-latex-compile "ox-latex" (texfile &optional snippet))
(defun org-create-formula-image-with-imagemagick (string tofile options buffer)
"This calls convert, which is included into imagemagick."
- (require 'org-latex)
+ (require 'ox-latex)
(let* ((tmpdir (if (featurep 'xemacs)
(temp-directory)
temporary-file-directory))
@@ -17585,7 +18666,7 @@ inspection."
(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.))))))
+ (dpi (number-to-string (* scale (floor (if buffer fnh 120.)))))
(fg (or (plist-get options (if buffer :foreground :html-foreground))
"black"))
(bg (or (plist-get options (if buffer :background :html-background))
@@ -17594,54 +18675,19 @@ inspection."
(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 (string= bg "Transparent") "white" bg))))
+ (let ((latex-header (org-create-formula--latex-header)))
+ (with-temp-file texfile
+ (insert latex-header)
+ (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")))
+ (org-latex-compile texfile t)
(if (not (file-exists-p pdffile))
(progn (message "Failed to create pdf file from %s" texfile) nil)
(condition-case nil
@@ -17652,7 +18698,7 @@ inspection."
"-antialias"
pdffile
"-quality" "100"
- ;; "-sharpen" "0x1.0"
+ ;; "-sharpen" "0x1.0"
pngfile)
(call-process "convert" nil nil nil
"-density" dpi
@@ -17660,7 +18706,7 @@ inspection."
"-antialias"
pdffile
"-quality" "100"
- ; "-sharpen" "0x1.0"
+ ;; "-sharpen" "0x1.0"
pngfile))
(error nil))
(if (not (file-exists-p pngfile))
@@ -17745,6 +18791,12 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
((eq attr :background) 'background))))
(color-values (face-attribute 'default attr nil))))))
+(defun org-dvipng-color-format (color-name)
+ "Convert COLOR-NAME to a RGB color value for dvipng."
+ (apply 'format "rgb %s %s %s"
+ (mapcar 'org-normalize-color
+ (color-values color-name))))
+
(defun org-latex-color (attr)
"Return a RGB color for the LaTeX color package."
(apply 'format "%s,%s,%s"
@@ -17766,8 +18818,9 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
"Return string to be used as color value for an RGB component."
(format "%g" (/ value 65535.0)))
-;; Image display
+
+;; Image display
(defvar org-inline-image-overlays nil)
(make-variable-buffer-local 'org-inline-image-overlays)
@@ -17781,7 +18834,8 @@ INCLUDE-LINKED is passed to `org-display-inline-images'."
(org-remove-inline-images)
(message "Inline image display turned off"))
(org-display-inline-images include-linked)
- (if org-inline-image-overlays
+ (if (and (org-called-interactively-p)
+ org-inline-image-overlays)
(message "%d images displayed inline"
(length org-inline-image-overlays))
(message "No images to display inline"))))
@@ -17805,35 +18859,54 @@ 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)))))))))
+ (when (display-graphic-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 "" "\\]")))
+ (case-fold-search t)
+ old file ov img type attrwidth width)
+ (while (re-search-forward re end t)
+ (setq old (get-char-property-and-overlay (match-beginning 1)
+ 'org-image-overlay)
+ file (expand-file-name
+ (concat (or (match-string 3) "") (match-string 4))))
+ (when (image-type-available-p 'imagemagick)
+ (setq attrwidth (if (or (listp org-image-actual-width)
+ (null org-image-actual-width))
+ (save-excursion
+ (save-match-data
+ (when (re-search-backward
+ "#\\+attr.*:width[ \t]+\\([^ ]+\\)"
+ (save-excursion
+ (re-search-backward "^[ \t]*$\\|\\`" nil t)) t)
+ (string-to-number (match-string 1))))))
+ width (cond ((eq org-image-actual-width t) nil)
+ ((null org-image-actual-width) attrwidth)
+ ((numberp org-image-actual-width)
+ org-image-actual-width)
+ ((listp org-image-actual-width)
+ (or attrwidth (car org-image-actual-width))))
+ type (if width 'imagemagick)))
+ (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 type nil :width width)))
+ (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")
@@ -17996,6 +19069,8 @@ BEG and END default to the buffer boundaries."
(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\M-f" 'org-next-block)
+(org-defkey org-mode-map "\C-c\M-b" 'org-previous-block)
(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)
@@ -18003,6 +19078,7 @@ BEG and END default to the buffer boundaries."
(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-xq" 'org-toggle-tags-groups)
(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)
@@ -18010,6 +19086,7 @@ BEG and END default to the buffer boundaries."
(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\M-w" 'org-copy)
(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)
@@ -18044,6 +19121,9 @@ BEG and END default to the buffer boundaries."
(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 [remap open-line] 'org-open-line)
+(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph)
+(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph)
(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)
@@ -18058,7 +19138,7 @@ BEG and END default to the buffer boundaries."
(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\C-e" 'org-export-dispatch)
(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)
@@ -18089,6 +19169,7 @@ BEG and END default to the buffer boundaries."
(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-xP" 'org-set-property-and-value)
(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)
@@ -18123,6 +19204,8 @@ BEG and END default to the buffer boundaries."
("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))
+ ("F" . org-next-block)
+ ("B" . org-previous-block)
("u" . (org-speed-move-safe 'outline-up-heading))
("j" . org-goto)
("g" . (org-refile t))
@@ -18130,6 +19213,7 @@ BEG and END default to the buffer boundaries."
("c" . org-cycle)
("C" . org-shifttab)
(" " . org-display-outline-path)
+ ("s" . org-narrow-to-subtree)
("=" . org-columns)
("Outline Structure Editing")
("U" . org-shiftmetaup)
@@ -18143,7 +19227,7 @@ BEG and END default to the buffer boundaries."
("^" . org-sort)
("w" . org-refile)
("a" . org-archive-subtree-default-with-confirmation)
- ("." . org-mark-subtree)
+ ("@" . org-mark-subtree)
("#" . org-toggle-comment)
("Clock Commands")
("I" . org-clock-in)
@@ -18190,7 +19274,7 @@ BEG and END default to the buffer boundaries."
"Show the available speed commands."
(interactive)
(if (not org-use-speed-commands)
- (error "Speed commands are not activated, customize `org-use-speed-commands'")
+ (user-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)
@@ -18338,7 +19422,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'."
(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"))
+ (user-error "Editing in invisible areas is prohibited, make them visible first"))
(if (and org-custom-properties-overlays
(y-or-n-p "Display invisible properties in this buffer? "))
(org-toggle-custom-properties-visibility)
@@ -18359,7 +19443,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'."
(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"))))))))
+ (user-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)) ?*)
@@ -18411,9 +19495,8 @@ because, in this case the deletion might narrow the column."
(let ((pos (point))
(noalign (looking-at "[^|\n\r]* |"))
(c org-table-may-need-update))
- (replace-match (concat
- (substring (match-string 0) 1 -1)
- " |"))
+ (replace-match
+ (concat (substring (match-string 0) 1 -1) " |") nil t)
(goto-char pos)
;; noalign: if there were two spaces at the end, this field
;; does not determine the width of the column.
@@ -18452,6 +19535,16 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey map (vector 'remap old) new)
(substitute-key-definition old new map global-map)))))
+(defun org-transpose-words ()
+ "Transpose words for Org.
+This uses the `org-mode-transpose-word-syntax-table' syntax
+table, which interprets characters in `org-emphasis-alist' as
+word constituants."
+ (interactive)
+ (with-syntax-table org-mode-transpose-word-syntax-table
+ (call-interactively 'transpose-words)))
+(org-remap org-mode-map 'transpose-words 'org-transpose-words)
+
(when (eq org-enable-table-editor 'optimized)
;; If the user wants maximum table support, we need to hijack
;; some standard editing functions
@@ -18577,13 +19670,13 @@ 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"))
+ (user-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")))
+ (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'")
+ (user-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))
@@ -18591,9 +19684,9 @@ See `org-ctrl-c-ctrl-c-hook' for more information.")
(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."
+Call `org-table-previous-field' within a table.
+When ARG is nil, cycle globally through visibility states.
+When ARG is a numeric prefix, show contents of this level."
(interactive "P")
(cond
((org-at-table-p) (call-interactively 'org-table-previous-field))
@@ -18601,6 +19694,7 @@ See the individual commands for more information."
(let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
(message "Content view to level: %d" arg)
(org-content (prefix-numeric-value arg2))
+ (org-cycle-show-empty-lines t)
(setq org-cycle-global-status 'overview)))
(t (call-interactively 'org-global-cycle))))
@@ -18649,7 +19743,7 @@ See the individual commands for more information."
((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))))
+ (t (call-interactively 'org-drag-line-backward))))
(defun org-shiftmetadown (&optional arg)
"Move subtree down or insert table row.
@@ -18664,10 +19758,10 @@ See the individual commands for more information."
((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))))
+ (t (call-interactively 'org-drag-line-forward))))
(defsubst org-hidden-tree-error ()
- (error
+ (user-error
"Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
(defun org-metaleft (&optional arg)
@@ -18757,18 +19851,6 @@ this function returns t, nil otherwise."
(throw 'exit t))))
nil))))
-(org-autoload "org-element" '(org-element-at-point org-element-type))
-
-(declare-function org-element-at-point "org-element" (&optional keep-trail))
-(declare-function org-element-type "org-element" (element))
-(declare-function org-element-contents "org-element" (element))
-(declare-function org-element-property "org-element" (property element))
-(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
@@ -18959,22 +20041,24 @@ Depending on context, this does one of the following:
(org-call-for-shift-select 'backward-word))
(t (org-shiftselect-error))))
-(defun org-shiftcontrolup ()
- "Change timestamps synchronously up in CLOCK log lines."
- (interactive)
+(defun org-shiftcontrolup (&optional n)
+ "Change timestamps synchronously up in CLOCK log lines.
+Optional argument N tells to change by that many units."
+ (interactive "P")
(cond ((and (not org-support-shift-select)
(org-at-clock-log-p)
(org-at-timestamp-p t))
- (org-clock-timestamps-up))
+ (org-clock-timestamps-up n))
(t (org-shiftselect-error))))
-(defun org-shiftcontroldown ()
- "Change timestamps synchronously down in CLOCK log lines."
- (interactive)
+(defun org-shiftcontroldown (&optional n)
+ "Change timestamps synchronously down in CLOCK log lines.
+Optional argument N tells to change by that many units."
+ (interactive "P")
(cond ((and (not org-support-shift-select)
(org-at-clock-log-p)
(org-at-timestamp-p t))
- (org-clock-timestamps-down))
+ (org-clock-timestamps-down n))
(t (org-shiftselect-error))))
(defun org-ctrl-c-ret ()
@@ -19040,38 +20124,51 @@ See the individual commands for more information."
(eq 'fixed-width (org-element-type (org-element-at-point)))))
(defun org-edit-special (&optional arg)
- "Call a special editor for the stuff at point.
+ "Call a special editor for the element at point.
When at a table, call the formula editor with `org-table-edit-formulas'.
When in a source code block, call `org-edit-src-code'.
When in a fixed-width region, call `org-edit-fixed-width-region'.
-When in an #+include line, visit the included file.
+When at an #+INCLUDE keyword, visit the included file.
On a link, call `ffap' to visit the link at point.
Otherwise, return a user error."
- (interactive)
- ;; possibly prep session before editing source
- (when (and (org-in-src-block-p) 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-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))
- ((org-in-block-p '("src" "example" "latex" "html")) (org-edit-src-code))
- ((org-in-fixed-width-region-p) (org-edit-fixed-width-region))
- ((org-at-regexp-p org-any-link-re) (call-interactively 'ffap))
- (t (user-error "No special environment to edit here"))))
+ (interactive "P")
+ (let ((element (org-element-at-point)))
+ (assert (not buffer-read-only) nil
+ "Buffer is read-only: %s" (buffer-name))
+ (case (org-element-type element)
+ (src-block
+ (if (not arg) (org-edit-src-code)
+ (let* ((info (org-babel-get-src-block-info))
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (session (cdr (assq :session params))))
+ (if (not session) (org-edit-src-code)
+ ;; At a src-block with a session and function called with
+ ;; an ARG: switch to the buffer related to the inferior
+ ;; process.
+ (switch-to-buffer
+ (funcall (intern (concat "org-babel-prep-session:" lang))
+ session params))))))
+ (keyword
+ (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE"))
+ (find-file
+ (org-remove-double-quotes
+ (car (org-split-string (org-element-property :value element)))))
+ (user-error "No special environment to edit here")))
+ (table
+ (if (eq (org-element-property :type element) 'table.el)
+ (org-edit-src-code)
+ (call-interactively 'org-table-edit-formulas)))
+ ;; Only Org tables contain `table-row' type elements.
+ (table-row (call-interactively 'org-table-edit-formulas))
+ ((example-block export-block) (org-edit-src-code))
+ (fixed-width (org-edit-fixed-width-region))
+ (otherwise
+ ;; No notable element at point. Though, we may be at a link,
+ ;; which is an object. Thus, scan deeper.
+ (if (eq (org-element-type (org-element-context element)) 'link)
+ (call-interactively 'ffap)
+ (user-error "No special environment to edit here"))))))
(defvar org-table-coordinate-overlays) ; defined in org-table.el
(defun org-ctrl-c-ctrl-c (&optional arg)
@@ -19119,136 +20216,161 @@ This command does many different things, depending on context:
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)))
- (if (equal struct old-struct)
- (user-error "Cannot toggle this checkbox (unchecked subitems?)")
- (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"))))))
+ (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))
+ (t
+ (let* ((context (org-element-context)) (type (org-element-type context)))
+ ;; Test if point is within a blank line.
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))
+ (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
+ (user-error "C-c C-c can do nothing useful at this location"))
+ ;; When at a link, act according to the parent instead.
+ (when (eq type 'link)
+ (setq context (org-element-property :parent context))
+ (setq type (org-element-type context)))
+ ;; For convenience: at the first line of a paragraph on the
+ ;; same line as an item, apply function on that item instead.
+ (when (eq type 'paragraph)
+ (let ((parent (org-element-property :parent context)))
+ (when (and (eq (org-element-type parent) 'item)
+ (= (point-at-bol) (org-element-property :begin parent)))
+ (setq context parent type 'item))))
+ ;; Act according to type of element or object at point.
+ (case type
+ (clock (org-clock-update-time-maybe))
+ (dynamic-block
+ (save-excursion
+ (goto-char (org-element-property :post-affiliated context))
+ (org-update-dblock)))
+ (footnote-definition
+ (goto-char (org-element-property :post-affiliated context))
+ (call-interactively 'org-footnote-action))
+ (footnote-reference (call-interactively 'org-footnote-action))
+ ((headline inlinetask)
+ (save-excursion (goto-char (org-element-property :begin context))
+ (call-interactively 'org-set-tags)))
+ (item
+ ;; At an item: a double C-u set checkbox to "[-]"
+ ;; unconditionally, whereas a single one will toggle its
+ ;; presence. Without an universal argument, if the item
+ ;; has a checkbox, toggle it. Otherwise repair the list.
+ (let* ((box (org-element-property :checkbox context))
+ (struct (org-element-property :structure context))
+ (old-struct (copy-tree struct))
+ (parents (org-list-parents-alist struct))
+ (prevs (org-list-prevs-alist struct))
+ (orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
+ (org-list-set-checkbox
+ (org-element-property :begin context) struct
+ (cond ((equal arg '(16)) "[-]")
+ ((and (not box) (equal arg '(4))) "[ ]")
+ ((or (not box) (equal arg '(4))) nil)
+ ((eq box 'on) "[ ]")
+ (t "[X]")))
+ ;; Mimic `org-list-write-struct' but with 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)
+ (org-list-struct-fix-bul struct prevs)
+ (org-list-struct-fix-ind struct parents)
+ (let ((block-item
+ (org-list-struct-fix-box struct parents prevs orderedp)))
+ (if (and box (equal struct old-struct))
+ (if (equal arg '(16))
+ (message "Checkboxes already reset")
+ (user-error "Cannot toggle this checkbox: %s"
+ (if (eq box 'on)
+ "all subitems checked"
+ "unchecked subitems")))
+ (org-list-struct-apply-struct struct old-struct)
+ (org-update-checkbox-count-maybe))
+ (when block-item
+ (message "Checkboxes were removed due to empty box at line %d"
+ (org-current-line block-item))))))
+ (keyword
+ (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"))
+ (plain-list
+ ;; At a plain list, with a double C-u argument, set
+ ;; checkboxes of each item to "[-]", whereas a single one
+ ;; will toggle their presence according to the state of the
+ ;; first item in the list. Without an argument, repair the
+ ;; list.
+ (let* ((begin (org-element-property :contents-begin context))
+ (beginm (move-marker (make-marker) begin))
+ (struct (org-element-property :structure context))
+ (old-struct (copy-tree struct))
+ (first-box (save-excursion
+ (goto-char begin)
+ (looking-at org-list-full-item-re)
+ (match-string-no-properties 3)))
+ (new-box (cond ((equal arg '(16)) "[-]")
+ ((equal arg '(4)) (unless first-box "[ ]"))
+ ((equal first-box "[X]") "[ ]")
+ (t "[X]"))))
+ (cond
+ (arg
+ (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box))
+ (org-list-get-all-items
+ begin struct (org-list-prevs-alist struct))))
+ ((and first-box (eq (point) begin))
+ ;; For convenience, when point is at bol on the first
+ ;; item of the list and no argument is provided, simply
+ ;; toggle checkbox of that item, if any.
+ (org-list-set-checkbox begin struct new-box)))
+ (org-list-write-struct
+ struct (org-list-parents-alist struct) old-struct)
+ (org-update-checkbox-count-maybe)
+ (save-excursion (goto-char beginm) (org-list-send-list 'maybe))))
+ ((property-drawer node-property)
+ (call-interactively 'org-property-action))
+ ((radio-target target)
+ (call-interactively 'org-update-radio-target-regexp))
+ (statistics-cookie
+ (call-interactively 'org-update-statistics-cookies))
+ ((table table-cell table-row)
+ ;; At a table, recalculate every field and align it. Also
+ ;; send the table if necessary. If the table has
+ ;; a `table.el' type, just give up. At a table row or
+ ;; cell, maybe recalculate line but always align table.
+ (if (eq (org-element-property :type context) 'table.el)
+ (message "Use C-c ' to edit table.el tables")
+ (let ((org-enable-table-editor t))
+ (if (or (eq type 'table)
+ ;; Check if point is at a TBLFM line.
+ (and (eq type 'table-row)
+ (= (point) (org-element-property :end context))))
+ (save-excursion
+ (if (org-at-TBLFM-p)
+ (progn (require 'org-table)
+ (org-table-calc-current-TBLFM))
+ (goto-char (org-element-property :contents-begin context))
+ (org-call-with-arg 'org-table-recalculate (or arg t))
+ (orgtbl-send-table 'maybe)))
+ (org-table-maybe-eval-formula)
+ (cond (arg (call-interactively 'org-table-recalculate))
+ ((org-table-maybe-recalculate-line))
+ (t (org-table-align)))))))
+ (timestamp (org-timestamp-change 0 'day))
+ (otherwise
+ (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
+ (user-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.
@@ -19267,6 +20389,18 @@ Also updates the keyword regular expressions."
(let ((org-note-abort t))
(funcall org-finish-function))))
+(defun org-open-line (n)
+ "Insert a new row in tables, call `open-line' elsewhere.
+If `org-special-ctrl-o' is nil, just call `open-line' everywhere."
+ (interactive "*p")
+ (cond
+ ((not org-special-ctrl-o)
+ (open-line n))
+ ((org-at-table-p)
+ (org-table-insert-row))
+ (t
+ (open-line n))))
+
(defun org-return (&optional indent)
"Goto next table row or insert a newline.
Calls `org-table-next-row' or `newline', depending on context.
@@ -19347,13 +20481,13 @@ Calls `org-table-insert-hline', `org-toggle-item', or
"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
+If the first non blank line in the region is a 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."
+If it is normal text, change region into a list of items.
+With a prefix argument ARG, change the region in a single item."
(interactive "P")
(let ((shift-text
(function
@@ -19446,19 +20580,10 @@ argument ARG, change each line in region into an item."
(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 "-"))
+ ;; Case 3. Normal line with ARG: make the first line of region
+ ;; an item, and shift indentation of others lines to
+ ;; set them as item's body.
+ (arg (let* ((bul (org-list-bullet-string "-"))
(bul-len (length bul))
(ref-ind (org-get-indentation)))
(skip-chars-forward " \t")
@@ -19471,29 +20596,40 @@ argument ARG, change each line in region into an item."
(+ ref-ind bul-len)
(min end (save-excursion (or (outline-next-heading)
(point)))))
- (forward-line)))))))))
+ (forward-line))))
+ ;; Case 4. Normal line without ARG: turn each non-item line
+ ;; into an item.
+ (t
+ (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))))))))
(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.
+If there is no active region, only convert the current line.
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
+- If the first non blank line is a 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 normal line, turn each and every normal line (i.e.,
+ not an heading or an item) in the region into headings. If you
+ want to convert only the first line of this region, use one
+ universal prefix argument.
- 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."
+when a numeric prefix argument is given, its value determines the
+number of stars to add."
(interactive "P")
(let ((skip-blanks
(function
@@ -19511,7 +20647,7 @@ stars to add."
;; 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))
+ (if (listp current-prefix-arg) (setq current-prefix-arg 1))
(org-mark-element))
(if (org-region-active-p)
@@ -19537,10 +20673,9 @@ stars to add."
;; 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))
+ ;; subtract the star that will be added again by
+ ;; `org-list-to-subtree'
+ (if (numberp nstars) (1- nstars)
(or (org-current-level) 0))
?*))
(add-stars
@@ -19564,18 +20699,17 @@ stars to add."
(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))
- ?*))
+ (t (let* ((stars
+ (make-string
+ (if (numberp nstars) nstars (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)
+ (rpl (concat stars add-stars " "))
+ (lend (if (listp nstars) (save-excursion (end-of-line) (point)))))
+ (while (< (point) (if (equal nstars '(4)) lend 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))
@@ -19584,16 +20718,22 @@ stars to add."
(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."
+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))))
+ (org-check-before-invisible-edit 'insert)
+ (or (run-hook-with-args-until-success 'org-metareturn-hook)
+ (let* ((element (org-element-at-point))
+ (type (org-element-type element)))
+ (when (eq type 'table-row)
+ (setq element (org-element-property :parent element))
+ (setq type 'table))
+ (if (and (eq type 'table)
+ (eq (org-element-property :type element) 'org)
+ (>= (point) (org-element-property :contents-begin element))
+ (< (point) (org-element-property :contents-end element)))
+ (call-interactively 'org-table-wrap-region)
+ (call-interactively 'org-insert-heading)))))
;;; Menu entries
@@ -19826,7 +20966,7 @@ See the individual commands for more information."
["Timeline" org-timeline t]
["Tags/Property tree" org-match-sparse-tree t])
"--"
- ["Export/Publish..." org-export t]
+ ["Export/Publish..." org-export-dispatch t]
("LaTeX"
["Org CDLaTeX mode" org-cdlatex-mode :style toggle
:selected org-cdlatex-mode]
@@ -19836,8 +20976,7 @@ See the individual commands for more information."
(org-inside-LaTeX-fragment-p)]
["Insert citation" org-reftex-citation t]
"--"
- ["Template for BEAMER" (progn (require 'org-beamer)
- (org-insert-beamer-options-template)) t])
+ ["Template for BEAMER" (org-beamer-insert-options-template) t])
"--"
("MobileOrg"
["Push Files and Views" org-mobile-push t]
@@ -19952,55 +21091,63 @@ Your bug report will be posted to the Org-mode mailing list.
(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)))
+ '(org-agenda org-archive org-attach org-clock org-colview org-id
+ org-table org-timer)))
;;;###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))
+ (require 'loadhist)
+ (let* ((org-dir (org-find-library-dir "org"))
+ (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir))
+ (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?")
+ (remove-re (mapconcat 'identity
+ (mapcar (lambda (f) (concat "^" f "$"))
+ (list (if (featurep 'xemacs)
+ "org-colview"
+ "org-colview-xemacs")
+ "org" "org-loaddefs" "org-version"))
+ "\\|"))
+ (feats (delete-dups
+ (mapcar 'file-name-sans-extension
+ (mapcar 'file-name-nondirectory
+ (delq nil
+ (mapcar 'feature-file
+ features))))))
+ (lfeat (append
+ (sort
+ (setq feats
+ (delq nil (mapcar
+ (lambda (f)
+ (if (and (string-match feature-re f)
+ (not (string-match remove-re f)))
+ f nil))
+ feats)))
+ 'string-lessp)
+ (list "org-version" "org")))
+ (load-suffixes (when (boundp 'load-suffixes) load-suffixes))
+ (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes))
+ load-uncore load-misses)
+ (setq load-misses
+ (delq 't
+ (mapcar (lambda (f)
+ (or (org-load-noerror-mustsuffix (concat org-dir f))
+ (and (string= org-dir contrib-dir)
+ (org-load-noerror-mustsuffix (concat contrib-dir f)))
+ (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f))
+ (add-to-list 'load-uncore f 'append)
+ 't)
+ f))
+ lfeat)))
+ (if load-uncore
+ (message "The following feature%s found in load-path, please check if that's correct:\n%s"
+ (if (> (length load-uncore) 1) "s were" " was") load-uncore))
+ (if load-misses
+ (message "Some error occured while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s"
+ (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full))
+ (message "Successfully reloaded Org\n%s" (org-version nil 'full)))))
;;;###autoload
(defun org-customize ()
@@ -20088,7 +21235,10 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(defun org-in-verbatim-emphasis ()
(save-match-data
- (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~")))))
+ (and (org-in-regexp org-emph-re 2)
+ (>= (point) (match-beginning 3))
+ (<= (point) (match-end 4))
+ (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."
@@ -20543,6 +21693,17 @@ block from point."
names))
nil)))
+(defun org-in-drawer-p ()
+ "Is point within a drawer?"
+ (save-match-data
+ (let ((case-fold-search t)
+ (lim-up (save-excursion (outline-previous-heading)))
+ (lim-down (save-excursion (outline-next-heading))))
+ (org-between-regexps-p
+ (concat "^[ \t]*:" (regexp-opt org-drawers) ":")
+ "^[ \t]*:end:.*$"
+ lim-up lim-down))))
+
(defun org-occur-in-agenda-files (regexp &optional nlines)
"Call `multi-occur' with buffers for all agenda files."
(interactive "sOrg-files matching: \np")
@@ -20598,11 +21759,36 @@ for the search purpose."
(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-reverse-string (string)
+ "Return the reverse of STRING."
+ (apply 'string (reverse (string-to-list string))))
+
+(defsubst org-uniquify (list)
+ "Non-destructively remove duplicate elements from LIST."
+ (let ((res (copy-sequence list))) (delete-dups res)))
+
+(defun org-uniquify-alist (alist)
+ "Merge elements of ALIST with the same key.
+
+For example, in this alist:
+
+\(org-uniquify-alist '((a 1) (b 2) (a 3)))
+ => '((a 1 3) (b 2))
+
+merge (a 1) and (a 3) into (a 1 3).
+
+The function returns the new ALIST."
+ (let (rtn)
+ (mapc
+ (lambda (e)
+ (let (n)
+ (if (not (assoc (car e) rtn))
+ (push e rtn)
+ (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e))))
+ (setq rtn (assq-delete-all (car e) rtn))
+ (push n rtn))))
+ alist)
+ rtn))
(defun org-delete-all (elts list)
"Remove all elements in ELTS from LIST."
@@ -20649,6 +21835,20 @@ Taken from `reduce' in cl-seq.el with all keyword arguments but
(setq cl-accum (funcall cl-func cl-accum (pop cl-seq))))
cl-accum))
+(defun org-every (pred seq)
+ "Return true if PREDICATE is true of every element of SEQ.
+Adapted from `every' in cl.el."
+ (catch 'org-every
+ (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq)
+ t))
+
+(defun org-some (pred seq)
+ "Return true if PREDICATE is true of any element of SEQ.
+Adapted from `some' in cl.el."
+ (catch 'org-some
+ (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq)
+ nil))
+
(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."
@@ -20764,21 +21964,31 @@ If EXTENSIONS is given, only match these."
(save-match-data
(string-match (org-image-file-name-regexp extensions) file)))
-(defun org-get-cursor-date ()
+(defun org-get-cursor-date (&optional with-time)
"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)
+returns the current time.
+If WITH-TIME is non-nil, returns the time of the event at point (in
+the agenda) or the current time of the day."
+ (let (date day defd tp tm hod mod)
+ (when with-time
+ (setq tp (get-text-property (point) 'time))
+ (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp))
+ (setq hod (string-to-number (match-string 1 tp))
+ mod (string-to-number (match-string 2 tp))))
+ (or tp (setq hod (nth 2 (decode-time (current-time)))
+ mod (nth 1 (decode-time (current-time))))))
(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))))
+ defd (encode-time 0 (or mod 0) (or hod 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))))))
+ defd (encode-time 0 (or mod 0) (or hod 0)
+ (nth 1 date) (nth 0 date) (nth 2 date))))))
(or defd (current-time))))
(defun org-mark-subtree (&optional up)
@@ -20789,13 +21999,14 @@ 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"))
+ ((org-before-first-heading-p) (user-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 ()
@@ -20817,8 +22028,6 @@ hierarchy of headlines by UP levels before marking the subtree."
(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
@@ -20874,15 +22083,16 @@ hierarchy of headlines by UP levels before marking the subtree."
(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 a list item above.
+ ((ignore-errors (goto-char (org-in-item-p)))
+ (goto-char (org-list-get-top-point (org-list-struct)))
+ (setq column (org-get-indentation)))
;; There was an heading above.
((looking-at "\\*+[ \t]+")
(if (not org-adapt-indentation)
@@ -20903,11 +22113,10 @@ hierarchy of headlines by UP levels before marking the subtree."
;; 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)
+ (if (looking-at org-property-re)
+ (replace-match (concat (match-string 4)
(format org-property-format
- (match-string 2) (match-string 3)))
+ (match-string 1) (match-string 3)))
t t))
(org-move-to-column column))))
@@ -20959,7 +22168,7 @@ hierarchy of headlines by UP levels before marking the subtree."
(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))
+ (cond ((org-in-src-block-p t) (org-src-native-tab-command-maybe))
(t (call-interactively 'org-indent-line)))
(move-beginning-of-line 2)))))
@@ -20980,102 +22189,115 @@ hierarchy of headlines by UP levels before marking the subtree."
;; `org-setup-filling' installs filling and auto-filling related
;; variables during `org-mode' initialization.
+(defvar org-element-paragraph-separate) ; org-element.el
(defun org-setup-filling ()
- (interactive)
+ (require 'org-element)
;; 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-fill-line-break-nobreak-p
org-fill-paragraph-with-timestamp-nobreak-p)))))
+ (let ((paragraph-ending (substring org-element-paragraph-separate 1)))
+ (org-set-local 'paragraph-start paragraph-ending)
+ (org-set-local 'paragraph-separate paragraph-ending))
(org-set-local 'fill-paragraph-function 'org-fill-paragraph)
(org-set-local 'auto-fill-inhibit-regexp nil)
(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."
+ "Non-nil when a new line at point would create an Org line break."
(save-excursion
(skip-chars-backward "[ \t]")
(skip-chars-backward "\\\\")
(looking-at "\\\\\\\\\\($\\|[^\\\\]\\)")))
(defun org-fill-paragraph-with-timestamp-nobreak-p ()
- "Non-nil when a line break at point would insert a new item."
+ "Non-nil when a new line at point would split a timestamp."
(and (org-at-timestamp-p t)
(not (looking-at org-ts-regexp-both))))
(declare-function message-in-body-p "message" ())
-(defvar org-element--affiliated-re) ; From org-element.el
(defvar orgtbl-line-start-regexp) ; From org-table.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."
- (let (prefix)
- (catch 'exit
- (when (derived-mode-p 'message-mode)
- (save-excursion
- (beginning-of-line)
- (cond ((or (not (message-in-body-p))
- (looking-at orgtbl-line-start-regexp))
- (throw 'exit nil))
- ((looking-at message-cite-prefix-regexp)
- (throw 'exit (match-string-no-properties 0)))
- ((looking-at org-outline-regexp)
- (throw 'exit (make-string (length (match-string 0)) ? ))))))
- (org-with-wide-buffer
- (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)))
+meant to be filled. For convenience, if `adaptive-fill-regexp'
+matches in paragraphs or comments, use it."
+ (catch 'exit
+ (when (derived-mode-p 'message-mode)
+ (save-excursion
+ (beginning-of-line)
+ (cond ((or (not (message-in-body-p))
+ (looking-at orgtbl-line-start-regexp))
+ (throw 'exit nil))
+ ((looking-at message-cite-prefix-regexp)
+ (throw 'exit (match-string-no-properties 0)))
+ ((looking-at org-outline-regexp)
+ (throw 'exit (make-string (length (match-string 0)) ? ))))))
+ (org-with-wide-buffer
+ (let* ((p (line-beginning-position))
+ (element (save-excursion
+ (beginning-of-line)
+ (or (ignore-errors (org-element-at-point))
+ (user-error "An element cannot be parsed line %d"
+ (line-number-at-pos (point))))))
+ (type (org-element-type element))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (unless (and post-affiliated (< p post-affiliated))
+ (case type
+ (comment
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*")
+ (concat (match-string 0) "# ")))
+ (footnote-definition "")
+ ((item plain-list)
+ (make-string (org-list-item-body-column
+ (or post-affiliated
+ (org-element-property :begin element)))
+ ? ))
+ (paragraph
+ ;; Fill prefix is usually the same as the current line,
+ ;; unless the paragraph is at the beginning of an item.
+ (let ((parent (org-element-property :parent element)))
+ (save-excursion
+ (beginning-of-line)
(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)
- "")))))))))))
+ ((and adaptive-fill-regexp
+ ;; Locally disable
+ ;; `adaptive-fill-function' to let
+ ;; `fill-context-prefix' handle
+ ;; `adaptive-fill-regexp' variable.
+ (let (adaptive-fill-function)
+ (fill-context-prefix
+ post-affiliated
+ (org-element-property :end element)))))
+ ((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.
@@ -21104,94 +22326,120 @@ a footnote definition, try to fill the first paragraph within."
(paragraph-separate
(cadadr (assoc 'paragraph-separate org-fb-vars))))
(fill-paragraph nil))
- (save-excursion
+ (with-syntax-table org-mode-transpose-word-syntax-table
;; 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)))
+ (let ((element (save-excursion
+ (end-of-line)
+ (or (ignore-errors (org-element-at-point))
+ (user-error "An element cannot be parsed line %d"
+ (line-number-at-pos (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)
- ;; Use major mode filling function is src blocks.
- (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
- ;; 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)))))))
+ (case (org-element-type element)
+ ;; Use major mode filling function is src blocks.
+ (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
+ ;; Align Org tables, leave table.el tables as-is.
+ (table-row (org-table-align) t)
+ (table
+ (when (eq (org-element-property :type element) 'org)
+ (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (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 (< (line-end-position) 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 account.
+ ;; 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-restriction 'paragraph))
+ '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))))
+ (if (or (< (point) beg) (> (point) end)) t
+ (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))))
+ ;; Fill comments.
+ (comment
+ (let ((begin (org-element-property :post-affiliated element))
+ (end (org-element-property :end element)))
+ (when (and (>= (point) begin) (<= (point) end))
+ (let ((begin (save-excursion
+ (end-of-line)
+ (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
+ (progn (forward-line) (point))
+ begin)))
+ (end (save-excursion
+ (end-of-line)
+ (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
+ (1- (line-beginning-position))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position)))))
+ ;; Do not fill comments when at a blank line.
+ (when (> end begin)
+ (let ((fill-prefix
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#")
+ (let ((comment-prefix (match-string 0)))
+ (goto-char (match-end 0))
+ (if (looking-at adaptive-fill-regexp)
+ (concat comment-prefix (match-string 0))
+ (concat comment-prefix " "))))))
+ (save-excursion
+ (fill-region-as-paragraph begin end justify))))))
+ t))
+ ;; Ignore every other element.
+ (otherwise t))))))
(defun org-auto-fill-function ()
"Auto-fill function."
@@ -21298,11 +22546,102 @@ contains commented lines. Otherwise, comment them."
(goto-char (point-min))
(while (not (eobp))
(unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
- (org-move-to-column min-indent t)
+ ;; Don't get fooled by invisible text (e.g. link path)
+ ;; when moving to column MIN-INDENT.
+ (let ((buffer-invisibility-spec nil))
+ (org-move-to-column min-indent t))
(insert comment-start))
(forward-line))))))))
+;;; Planning
+
+;; This section contains tools to operate on timestamp objects, as
+;; returned by, e.g. `org-element-context'.
+
+(defun org-timestamp-has-time-p (timestamp)
+ "Non-nil when TIMESTAMP has a time specified."
+ (org-element-property :hour-start timestamp))
+
+(defun org-timestamp-format (timestamp format &optional end utc)
+ "Format a TIMESTAMP element into a string.
+
+FORMAT is a format specifier to be passed to
+`format-time-string'.
+
+When optional argument END is non-nil, use end of date-range or
+time-range, if possible.
+
+When optional argument UTC is non-nil, time will be expressed as
+Universal Time."
+ (format-time-string
+ format
+ (apply 'encode-time
+ (cons 0
+ (mapcar
+ (lambda (prop) (or (org-element-property prop timestamp) 0))
+ (if end '(:minute-end :hour-end :day-end :month-end :year-end)
+ '(:minute-start :hour-start :day-start :month-start
+ :year-start)))))
+ utc))
+
+(defun org-timestamp-split-range (timestamp &optional end)
+ "Extract a timestamp object from a date or time range.
+
+TIMESTAMP is a timestamp object. END, when non-nil, means extract
+the end of the range. Otherwise, extract its start.
+
+Return a new timestamp object sharing the same parent as
+TIMESTAMP."
+ (let ((type (org-element-property :type timestamp)))
+ (if (memq type '(active inactive diary)) timestamp
+ (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp)))))
+ ;; Set new type.
+ (org-element-put-property
+ split-ts :type (if (eq type 'active-range) 'active 'inactive))
+ ;; Copy start properties over end properties if END is
+ ;; non-nil. Otherwise, copy end properties over `start' ones.
+ (let ((p-alist '((:minute-start . :minute-end)
+ (:hour-start . :hour-end)
+ (:day-start . :day-end)
+ (:month-start . :month-end)
+ (:year-start . :year-end))))
+ (dolist (p-cell p-alist)
+ (org-element-put-property
+ split-ts
+ (funcall (if end 'car 'cdr) p-cell)
+ (org-element-property
+ (funcall (if end 'cdr 'car) p-cell) split-ts)))
+ ;; Eventually refresh `:raw-value'.
+ (org-element-put-property split-ts :raw-value nil)
+ (org-element-put-property
+ split-ts :raw-value (org-element-interpret-data split-ts)))))))
+
+(defun org-timestamp-translate (timestamp &optional boundary)
+ "Apply `org-translate-time' on a TIMESTAMP object.
+When optional argument BOUNDARY is non-nil, it is either the
+symbol `start' or `end'. In this case, only translate the
+starting or ending part of TIMESTAMP if it is a date or time
+range. Otherwise, translate both parts."
+ (if (and (not boundary)
+ (memq (org-element-property :type timestamp)
+ '(active-range inactive-range)))
+ (concat
+ (org-translate-time
+ (org-element-property :raw-value
+ (org-timestamp-split-range timestamp)))
+ "--"
+ (org-translate-time
+ (org-element-property :raw-value
+ (org-timestamp-split-range timestamp t))))
+ (org-translate-time
+ (org-element-property
+ :raw-value
+ (if (not boundary) timestamp
+ (org-timestamp-split-range timestamp (eq boundary 'end)))))))
+
+
+
;;; Other stuff.
(defun org-toggle-fixed-width-section (arg)
@@ -21365,7 +22704,7 @@ 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."
+package ox-bibtex by Taru Karttunen."
(interactive)
(let ((reftex-docstruct-symbol 'rds)
(reftex-cite-format "\\cite{%l}")
@@ -21396,7 +22735,7 @@ beyond the end of the headline."
(special (if (consp org-special-ctrl-a/e)
(car org-special-ctrl-a/e)
org-special-ctrl-a/e))
- refpos)
+ deactivate-mark refpos)
(if (org-bound-and-true-p visual-line-mode)
(beginning-of-visual-line 1)
(beginning-of-line 1))
@@ -21448,7 +22787,10 @@ beyond the end of the headline."
(when (and (= (point) pos) (eq last-command this-command))
(goto-char after-bullet))))))))
(org-no-warnings
- (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
+ (and (featurep 'xemacs) (setq zmacs-region-stays t))))
+ (setq disable-point-adjustment
+ (or (not (invisible-p (point)))
+ (not (invisible-p (max (point-min) (1- (point))))))))
(defun org-end-of-line (&optional arg)
"Go to the end of the line.
@@ -21461,7 +22803,8 @@ the cursor is already beyond the end of the headline."
(move-fun (cond ((org-bound-and-true-p visual-line-mode)
'end-of-visual-line)
((fboundp 'move-end-of-line) 'move-end-of-line)
- (t 'end-of-line))))
+ (t 'end-of-line)))
+ deactivate-mark)
(if (or (not special) arg) (call-interactively move-fun)
(let* ((element (save-excursion (beginning-of-line)
(org-element-at-point)))
@@ -21485,7 +22828,10 @@ the cursor is already beyond the end of the headline."
;; after it. Use `end-of-line' to stay on current line.
(call-interactively 'end-of-line))
(t (call-interactively move-fun)))))
- (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
+ (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t))))
+ (setq disable-point-adjustment
+ (or (not (invisible-p (point)))
+ (not (invisible-p (max (point-min) (1- (point))))))))
(define-key org-mode-map "\C-a" 'org-beginning-of-line)
(define-key org-mode-map "\C-e" 'org-end-of-line)
@@ -21522,7 +22868,7 @@ depending on context."
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")))
+ (user-error "C-k aborted as it would kill a hidden subtree")))
(call-interactively
(if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line)))
((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))
@@ -21741,7 +23087,7 @@ make a significant difference in outlines with very many siblings."
(let ((re org-outline-regexp-bol)
level l)
(unless (org-at-heading-p t)
- (error "Not at a heading"))
+ (user-error "Not at a heading"))
(setq level (funcall outline-level))
(save-excursion
(if (not (re-search-backward re nil t))
@@ -21899,77 +23245,248 @@ clocking lines, and drawers."
(point)))
(defun org-forward-heading-same-level (arg &optional invisible-ok)
- "Move forward to the arg'th subheading at same level as this one.
+ "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)))
+ (if (not (ignore-errors (org-back-to-heading invisible-ok)))
+ (if (and arg (< arg 0))
+ (goto-char (point-min))
+ (outline-next-heading))
+ (org-at-heading-p)
+ (let ((level (- (match-end 0) (match-beginning 0) 1))
+ (f (if (and arg (< arg 0))
+ 're-search-backward
+ 're-search-forward))
+ (count (if arg (abs arg) 1))
+ (result (point)))
+ (while (and (prog1 (> count 0)
+ (forward-char (if (and arg (< arg 0)) -1 1)))
+ (funcall f org-outline-regexp-bol nil 'move))
+ (let ((l (- (match-end 0) (match-beginning 0) 1)))
+ (cond ((< l level) (setq count 0))
+ ((and (= l level)
+ (or invisible-ok
+ (progn
+ (goto-char (line-beginning-position))
+ (not (outline-invisible-p)))))
+ (setq count (1- count))
+ (when (eq l level)
+ (setq result (point)))))))
+ (goto-char result))
(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.
+ "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)))))
+ (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok))
+
+(defun org-next-block (arg &optional backward block-regexp)
+ "Jump to the next block.
+With a prefix argument ARG, jump forward ARG many source blocks.
+When BACKWARD is non-nil, jump to the previous block.
+When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
+ (interactive "p")
+ (let ((re (or block-regexp org-block-regexp))
+ (re-search-fn (or (and backward 're-search-backward)
+ 're-search-forward)))
+ (if (looking-at re) (forward-char 1))
+ (condition-case nil
+ (funcall re-search-fn re nil nil arg)
+ (error (error "No %s code blocks" (if backward "previous" "further" ))))
+ (goto-char (match-beginning 0)) (org-show-context)))
+
+(defun org-previous-block (arg &optional block-regexp)
+ "Jump to the previous block.
+With a prefix argument ARG, jump backward ARG many source blocks.
+When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
+ (interactive "p")
+ (org-next-block arg t block-regexp))
+
+(defun org-forward-paragraph ()
+ "Move forward to beginning of next paragraph or equivalent.
+
+The function moves point to the beginning of the next visible
+structural element, which can be a paragraph, a table, a list
+item, etc. It also provides some special moves for convenience:
+
+ - On an affiliated keyword, jump to the beginning of the
+ relative element.
+ - On an item or a footnote definition, move to the second
+ element inside, if any.
+ - On a table or a property drawer, jump after it.
+ - On a verse or source block, stop after blank lines."
+ (interactive)
+ (when (eobp) (user-error "Cannot move further down"))
+ (let* ((deactivate-mark nil)
+ (element (org-element-at-point))
+ (type (org-element-type element))
+ (post-affiliated (org-element-property :post-affiliated element))
+ (contents-begin (org-element-property :contents-begin element))
+ (contents-end (org-element-property :contents-end element))
+ (end (let ((end (org-element-property :end element)) (parent element))
+ (while (and (setq parent (org-element-property :parent parent))
+ (= (org-element-property :contents-end parent) end))
+ (setq end (org-element-property :end parent)))
+ end)))
+ (cond ((not element)
+ (skip-chars-forward " \r\t\n")
+ (or (eobp) (beginning-of-line)))
+ ;; On affiliated keywords, move to element's beginning.
+ ((and post-affiliated (< (point) post-affiliated))
+ (goto-char post-affiliated))
+ ;; At a table row, move to the end of the table. Similarly,
+ ;; at a node property, move to the end of the property
+ ;; drawer.
+ ((memq type '(node-property table-row))
+ (goto-char (org-element-property
+ :end (org-element-property :parent element))))
+ ((memq type '(property-drawer table)) (goto-char end))
+ ;; Consider blank lines as separators in verse and source
+ ;; blocks to ease editing.
+ ((memq type '(src-block verse-block))
+ (when (eq type 'src-block)
+ (setq contents-end
+ (save-excursion (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (beginning-of-line)
+ (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n"))
+ (if (not (re-search-forward "^[ \t]*$" contents-end t))
+ (goto-char end)
+ (skip-chars-forward " \r\t\n")
+ (if (= (point) contents-end) (goto-char end)
+ (beginning-of-line))))
+ ;; With no contents, just skip element.
+ ((not contents-begin) (goto-char end))
+ ;; If contents are invisible, skip the element altogether.
+ ((outline-invisible-p (line-end-position))
+ (case type
+ (headline
+ (org-with-limited-levels (outline-next-visible-heading 1)))
+ ;; At a plain list, make sure we move to the next item
+ ;; instead of skipping the whole list.
+ (plain-list (forward-char)
+ (org-forward-paragraph))
+ (otherwise (goto-char end))))
+ ((>= (point) contents-end) (goto-char end))
+ ((>= (point) contents-begin)
+ ;; This can only happen on paragraphs and plain lists.
+ (case type
+ (paragraph (goto-char end))
+ ;; At a plain list, try to move to second element in
+ ;; first item, if possible.
+ (plain-list (end-of-line)
+ (org-forward-paragraph))))
+ ;; When contents start on the middle of a line (e.g. in
+ ;; items and footnote definitions), try to reach first
+ ;; element starting after current line.
+ ((> (line-end-position) contents-begin)
+ (end-of-line)
+ (org-forward-paragraph))
+ (t (goto-char contents-begin)))))
+
+(defun org-backward-paragraph ()
+ "Move backward to start of previous paragraph or equivalent.
+
+The function moves point to the beginning of the current
+structural element, which can be a paragraph, a table, a list
+item, etc., or to the beginning of the previous visible one if
+point is already there. It also provides some special moves for
+convenience:
+
+ - On an affiliated keyword, jump to the first one.
+ - On a table or a property drawer, move to its beginning.
+ - On a verse or source block, stop before blank lines."
+ (interactive)
+ (when (bobp) (user-error "Cannot move further up"))
+ (let* ((deactivate-mark nil)
+ (element (org-element-at-point))
+ (type (org-element-type element))
+ (contents-begin (org-element-property :contents-begin element))
+ (contents-end (org-element-property :contents-end element))
+ (post-affiliated (org-element-property :post-affiliated element))
+ (begin (org-element-property :begin element)))
+ (cond
+ ((not element) (goto-char (point-min)))
+ ((= (point) begin)
+ (backward-char)
+ (org-backward-paragraph))
+ ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin))
+ ((memq type '(node-property table-row))
+ (goto-char (org-element-property
+ :post-affiliated (org-element-property :parent element))))
+ ((memq type '(property-drawer table)) (goto-char begin))
+ ((memq type '(src-block verse-block))
+ (when (eq type 'src-block)
+ (setq contents-begin
+ (save-excursion (goto-char begin) (forward-line) (point))))
+ (if (= (point) contents-begin) (goto-char post-affiliated)
+ ;; Inside a verse block, see blank lines as paragraph
+ ;; separators.
+ (let ((origin (point)))
+ (skip-chars-backward " \r\t\n" contents-begin)
+ (when (re-search-backward "^[ \t]*$" contents-begin 'move)
+ (skip-chars-forward " \r\t\n" origin)
+ (if (= (point) origin) (goto-char contents-begin)
+ (beginning-of-line))))))
+ ((not contents-begin) (goto-char (or post-affiliated begin)))
+ ((eq type 'paragraph)
+ (goto-char contents-begin)
+ ;; When at first paragraph in an item or a footnote definition,
+ ;; move directly to beginning of line.
+ (let ((parent-contents
+ (org-element-property
+ :contents-begin (org-element-property :parent element))))
+ (when (and parent-contents (= parent-contents contents-begin))
+ (beginning-of-line))))
+ ;; At the end of a greater element, move to the beginning of the
+ ;; last element within.
+ ((>= (point) contents-end)
+ (goto-char (1- contents-end))
+ (org-backward-paragraph))
+ (t (goto-char (or post-affiliated begin))))
+ ;; Ensure we never leave point invisible.
+ (when (outline-invisible-p (point)) (beginning-of-visual-line))))
(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"))
+ (cond ((eobp) (user-error "Cannot move further down"))
((org-with-limited-levels (org-at-heading-p))
(let ((origin (point)))
- (org-forward-heading-same-level 1)
+ (goto-char (org-end-of-subtree nil t))
(unless (org-with-limited-levels (org-at-heading-p))
(goto-char origin)
- (error "Cannot move further down"))))
+ (user-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))))))
+ (cond ((and parent (= (org-element-property :contents-end parent) end))
+ (goto-char (org-element-property :end parent)))
+ ((integer-or-marker-p end) (goto-char end))
+ (t (message "No element at point")))))))
(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"))
+ (cond ((bobp) (user-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
+ ;; At a 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"))))
+ (org-with-limited-levels (org-backward-heading-same-level 1))
+ ;; When current headline has no sibling above, move to its
+ ;; parent.
+ (when (= (point) origin)
+ (or (org-with-limited-levels (org-up-heading-safe))
+ (progn (goto-char origin)
+ (user-error "Cannot move further up"))))))
(t
(let* ((trail (org-element-at-point 'keep-trail))
(elem (car trail))
@@ -21978,6 +23495,7 @@ Move to the previous element at the same level, when possible."
(cond
;; Move to beginning of current element if point isn't
;; there already.
+ ((null beg) (message "No element at point"))
((/= (point) beg) (goto-char beg))
(prev-elem (goto-char (org-element-property :begin prev-elem)))
((org-before-first-heading-p) (goto-char (point-min)))
@@ -21987,12 +23505,12 @@ Move to the previous element at the same level, when possible."
"Move to upper element."
(interactive)
(if (org-with-limited-levels (org-at-heading-p))
- (unless (org-up-heading-safe) (error "No surrounding element"))
+ (unless (org-up-heading-safe) (user-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")
+ (user-error "No surrounding element")
(org-with-limited-levels (org-back-to-heading)))))))
(defvar org-element-greater-elements)
@@ -22008,8 +23526,8 @@ Move to the previous element at the same level, when possible."
;; 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")))))
+ (user-error "No content for this element"))))
+ (t (user-error "No inner element")))))
(defun org-drag-element-backward ()
"Move backward element at point."
@@ -22021,7 +23539,7 @@ Move to the previous element at the same level, when possible."
;; 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")
+ (user-error "Cannot drag element backward")
(let ((pos (point)))
(org-element-swap-A-B prev-elem elem)
(goto-char (+ (org-element-property :begin prev-elem)
@@ -22033,14 +23551,14 @@ Move to the previous element at the same level, when possible."
(let* ((pos (point))
(elem (org-element-at-point)))
(when (= (point-max) (org-element-property :end elem))
- (error "Cannot drag element forward"))
+ (user-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"))
+ (user-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.
@@ -22061,6 +23579,25 @@ Move to the previous element at the same level, when possible."
(org-element-swap-A-B elem next-elem)
(goto-char (+ pos size-next size-blank))))))
+(defun org-drag-line-forward (arg)
+ "Drag the line at point ARG lines forward."
+ (interactive "p")
+ (dotimes (n (abs arg))
+ (let ((c (current-column)))
+ (if (< 0 arg)
+ (progn
+ (beginning-of-line 2)
+ (transpose-lines 1)
+ (beginning-of-line 0))
+ (transpose-lines 1)
+ (beginning-of-line -1))
+ (org-move-to-column c))))
+
+(defun org-drag-line-backward (arg)
+ "Drag the line at point ARG lines backward."
+ (interactive "p")
+ (org-drag-line-forward (- arg)))
+
(defun org-mark-element ()
"Put point at beginning of this element, mark at end.
@@ -22114,7 +23651,7 @@ 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"))
+ (user-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
@@ -22244,8 +23781,8 @@ Show the heading too, if it is currently invisible."
(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"
+ "Replace a link with its the description.
+If there is no description, use the link target."
(save-match-data
(if (string-match org-bracket-link-analytic-regexp link)
(replace-match (if (match-end 5)
@@ -22302,14 +23839,16 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(let ((default-directory dir))
(expand-file-name txt)))
(unless (derived-mode-p 'org-mode)
- (error "Cannot restrict to non-Org-mode file"))
+ (user-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")))
+ (t (user-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)))
+(defvar speedbar-file-key-map)
+(declare-function speedbar-add-supported-extension "speedbar" (extension))
(eval-after-load "speedbar"
'(progn
(speedbar-add-supported-extension ".org")
@@ -22323,9 +23862,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
;;; Fixes and Hacks for problems with other packages
;; Make flyspell not check words in links, to not mess up our keymap
+(defvar org-element-affiliated-keywords) ; From org-element.el
+(defvar org-element-block-name-alist) ; From org-element.el
(defun org-mode-flyspell-verify ()
"Don't let flyspell put overlays at active buttons, or on
{todo,all-time,additional-option-like}-keywords."
+ (require 'org-element) ; For `org-element-affiliated-keywords'
(let ((pos (max (1- (point)) (point-min)))
(word (thing-at-point 'word)))
(and (not (get-text-property pos 'keymap))
@@ -22334,7 +23876,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(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)))))
+ (not (member-ignore-case word org-element-affiliated-keywords))
+ (not (member-ignore-case word (org-get-export-keywords)))
+ (not (member-ignore-case
+ word (mapcar 'car org-element-block-name-alist)))
+ (not (member-ignore-case word '("BEGIN" "END" "ATTR")))
+ (not (org-in-src-block-p)))))
(defun org-remove-flyspell-overlays-in (beg end)
"Remove flyspell overlays in region."
@@ -22375,32 +23922,10 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(org-show-context 'bookmark-jump)))
;; Make session.el ignore our circular variable
+(defvar session-globals-exclude)
(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)
diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el
new file mode 100644
index 0000000000..32262cc9a6
--- /dev/null
+++ b/lisp/org/ox-ascii.el
@@ -0,0 +1,1973 @@
+;;; ox-ascii.el --- ASCII Back-End for Org Export Engine
+
+;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 an ASCII back-end for Org generic exporter.
+;; See Org manual for more information.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox)
+(require 'ox-publish)
+
+(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-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 'ascii
+ '((bold . org-ascii-bold)
+ (center-block . org-ascii-center-block)
+ (clock . org-ascii-clock)
+ (code . org-ascii-code)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (drawer . org-ascii-drawer)
+ (dynamic-block . org-ascii-dynamic-block)
+ (entity . org-ascii-entity)
+ (example-block . org-ascii-example-block)
+ (export-block . org-ascii-export-block)
+ (export-snippet . org-ascii-export-snippet)
+ (fixed-width . org-ascii-fixed-width)
+ (footnote-reference . org-ascii-footnote-reference)
+ (headline . org-ascii-headline)
+ (horizontal-rule . org-ascii-horizontal-rule)
+ (inline-src-block . org-ascii-inline-src-block)
+ (inlinetask . org-ascii-inlinetask)
+ (inner-template . org-ascii-inner-template)
+ (italic . org-ascii-italic)
+ (item . org-ascii-item)
+ (keyword . org-ascii-keyword)
+ (latex-environment . org-ascii-latex-environment)
+ (latex-fragment . org-ascii-latex-fragment)
+ (line-break . org-ascii-line-break)
+ (link . org-ascii-link)
+ (paragraph . org-ascii-paragraph)
+ (plain-list . org-ascii-plain-list)
+ (plain-text . org-ascii-plain-text)
+ (planning . org-ascii-planning)
+ (quote-block . org-ascii-quote-block)
+ (quote-section . org-ascii-quote-section)
+ (radio-target . org-ascii-radio-target)
+ (section . org-ascii-section)
+ (special-block . org-ascii-special-block)
+ (src-block . org-ascii-src-block)
+ (statistics-cookie . org-ascii-statistics-cookie)
+ (strike-through . org-ascii-strike-through)
+ (subscript . org-ascii-subscript)
+ (superscript . org-ascii-superscript)
+ (table . org-ascii-table)
+ (table-cell . org-ascii-table-cell)
+ (table-row . org-ascii-table-row)
+ (target . org-ascii-target)
+ (template . org-ascii-template)
+ (timestamp . org-ascii-timestamp)
+ (underline . org-ascii-underline)
+ (verbatim . org-ascii-verbatim)
+ (verse-block . org-ascii-verse-block))
+ :export-block "ASCII"
+ :menu-entry
+ '(?t "Export to Plain Text"
+ ((?A "As ASCII buffer"
+ (lambda (a s v b)
+ (org-ascii-export-as-ascii a s v b '(:ascii-charset ascii))))
+ (?a "As ASCII file"
+ (lambda (a s v b)
+ (org-ascii-export-to-ascii a s v b '(:ascii-charset ascii))))
+ (?L "As Latin1 buffer"
+ (lambda (a s v b)
+ (org-ascii-export-as-ascii a s v b '(:ascii-charset latin1))))
+ (?l "As Latin1 file"
+ (lambda (a s v b)
+ (org-ascii-export-to-ascii a s v b '(:ascii-charset latin1))))
+ (?U "As UTF-8 buffer"
+ (lambda (a s v b)
+ (org-ascii-export-as-ascii a s v b '(:ascii-charset utf-8))))
+ (?u "As UTF-8 file"
+ (lambda (a s v b)
+ (org-ascii-export-to-ascii a s v b '(:ascii-charset utf-8))))))
+ :filters-alist '((:filter-headline . org-ascii-filter-headline-blank-lines)
+ (:filter-parse-tree org-ascii-filter-paragraph-spacing
+ org-ascii-filter-comment-spacing)
+ (:filter-section . org-ascii-filter-headline-blank-lines))
+ :options-alist '((:ascii-charset nil nil org-ascii-charset)))
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-ascii nil
+ "Options for exporting Org mode files to ASCII."
+ :tag "Org Export ASCII"
+ :group 'org-export)
+
+(defcustom org-ascii-text-width 72
+ "Maximum width of exported text.
+This number includes margin size, as set in
+`org-ascii-global-margin'."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-ascii-global-margin 0
+ "Width of the left margin, in number of characters."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-ascii-inner-margin 2
+ "Width of the inner margin, in number of characters.
+Inner margin is applied between each headline."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-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-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-ascii-inlinetask-width 30
+ "Width of inline tasks, in number of characters.
+This number ignores any margin."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-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-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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-ascii-indented-line-width 'auto
+ "Additional indentation width for the first line in a paragraph.
+If the value is an integer, indent the first line of each
+paragraph by this number. If it is the symbol `auto' preserve
+indentation from original document."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (integer :tag "Number of white spaces characters")
+ (const :tag "Preserve original width" auto)))
+
+(defcustom org-ascii-paragraph-spacing 'auto
+ "Number of white lines between paragraphs.
+If the value is an integer, add this number of blank lines
+between contiguous paragraphs. If is it the symbol `auto', keep
+the same number of blank lines as in the original document."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (integer :tag "Number of blank lines")
+ (const :tag "Preserve original spacing" auto)))
+
+(defcustom org-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-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "ASCII" ascii)
+ (const :tag "Latin-1" latin1)
+ (const :tag "UTF-8" utf-8)))
+
+(defcustom org-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-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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-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-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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-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
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-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
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-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
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-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."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-ascii-caption-above nil
+ "When non-nil, place caption string before the element.
+Otherwise, place it right after it."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-ascii-verbatim-format "`%s'"
+ "Format string used for verbatim text and inline code."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-ascii-format-drawer-function nil
+ "Function called to format a drawer in ASCII.
+
+The function must accept three 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-ascii-format-drawer-default (name contents width)
+ \"Format a drawer element for ASCII export.\"
+ contents)"
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+(defcustom org-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-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-ascii-inlinetask-width\)
+ \(org-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-ascii--build-title inlinetask info width\)\)\)
+ \(if \(<= \(length title\) width\) title
+ \(org-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-ascii--current-text-width inlinetask info\)\)"
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+
+;;; Internal Functions
+
+;; Internal functions fall into three categories.
+
+;; The first one is about text formatting. The core function is
+;; `org-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-ascii-text-width'. Once this information is known,
+;; `org-ascii--fill-string', `org-ascii--justify-string',
+;; `org-ascii--box-string' and `org-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-ascii--build-toc'
+;; returns a complete table of contents, `org-ascii--list-listings'
+;; returns a list of referenceable src-block elements, and
+;; `org-ascii--list-tables' does the same for table elements.
+
+;; The third category includes general helper functions.
+;; `org-ascii--build-title' creates the title for a given headline
+;; or inlinetask element. `org-ascii--build-caption' returns the
+;; caption string associated to a table or a src-block.
+;; `org-ascii--describe-links' creates notes about links for
+;; insertion at the end of a section. It uses
+;; `org-ascii--unique-links' to get the list of links to describe.
+;; Eventually, `org-ascii--translate' translates a string according
+;; to language and charset specification.
+
+
+(defun org-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-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 (let ((double-space-p sentence-end-double-space))
+ (with-temp-buffer
+ (let ((fill-column text-width)
+ (use-hard-newlines t)
+ (sentence-end-double-space double-space-p))
+ (insert s)
+ (fill-region (point-min) (point-max) justify))
+ (buffer-string))))))
+
+(defun org-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)
+ ;; Disable `adaptive-fill-mode' so it doesn't prevent
+ ;; filling lines matching `adaptive-fill-regexp'.
+ (adaptive-fill-mode nil))
+ (while (< (point) (point-max))
+ (justify-current-line how)
+ (forward-line)))
+ (buffer-string)))
+
+(defun org-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-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-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-ascii-inlinetask-width)
+ ('headline
+ (- org-ascii-text-width
+ (let ((low-level-rank (org-export-low-level-p element info)))
+ (if low-level-rank (* low-level-rank 2) org-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-ascii-inlinetask-width
+ ;; No inlinetask: Remove global margin from text width.
+ (- org-ascii-text-width
+ org-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-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-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-ascii--checkbox parent-item info))
+ (length
+ (or (org-list-get-tag beg-item struct)
+ (org-list-get-bullet beg-item struct)))))))))))))
+
+(defun org-ascii--build-title
+ (element info text-width &optional underline notags toc)
+ "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-ascii-underline'
+specifications.
+
+If optional argument NOTAGS is non-nil, no tags will be added to
+the title.
+
+When optional argument TOC is non-nil, use optional title if
+possible. It doesn't apply to `inlinetask' elements."
+ (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-trim
+ (org-export-data
+ (if (and toc headlinep) (org-export-get-alt-title element info)
+ (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-ascii-underline)))))
+ (and under-char
+ (concat "\n"
+ (make-string (length first-part) under-char))))))))
+
+(defun org-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-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-export-get-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-ascii--has-caption-p))
+ (title-fmt (org-ascii--translate
+ (case (org-element-type element)
+ (table "Table %d:")
+ (src-block "Listing %d:"))
+ info)))
+ (org-ascii--fill-string
+ (concat (format title-fmt reference)
+ " "
+ (org-export-data caption info))
+ (org-ascii--current-text-width element info) info)))))
+
+(defun org-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-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-ascii--current-text-width keyword info)
+ (- org-ascii-text-width org-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-ascii--build-title
+ headline info (- text-width indent) nil
+ (or (not (plist-get info :with-tags))
+ (eq (plist-get info :with-tags) 'not-in-toc))
+ 'toc))))
+ (org-export-collect-headlines info n) "\n")))))
+
+(defun org-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-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-ascii--current-text-width keyword info)
+ (- org-ascii-text-width org-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-ascii--translate "Listing %d:" info)
+ (incf count))))
+ (concat
+ initial-text " "
+ (org-trim
+ (org-ascii--indent-string
+ (org-ascii--fill-string
+ ;; Use short name in priority, if available.
+ (let ((caption (or (org-export-get-caption src-block t)
+ (org-export-get-caption src-block))))
+ (org-export-data caption info))
+ (- text-width (length initial-text)) info)
+ (length initial-text))))))
+ (org-export-collect-listings info) "\n")))))
+
+(defun org-ascii--list-tables (keyword info)
+ "Return a list of tables.
+
+KEYWORD is the keyword that initiated the list of tables
+generation. INFO is a plist used as a communication channel."
+ (let ((title (org-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-ascii--current-text-width keyword info)
+ (- org-ascii-text-width org-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-ascii--translate "Table %d:" info)
+ (incf count))))
+ (concat
+ initial-text " "
+ (org-trim
+ (org-ascii--indent-string
+ (org-ascii--fill-string
+ ;; Use short name in priority, if available.
+ (let ((caption (or (org-export-get-caption table t)
+ (org-export-get-caption table))))
+ (org-export-data caption info))
+ (- text-width (length initial-text)) info)
+ (length initial-text))))))
+ (org-export-collect-tables info) "\n")))))
+
+(defun org-ascii--unique-links (element info)
+ "Return a list of unique link references in ELEMENT.
+
+ELEMENT is either a 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))))
+ ;; Ignore LINK if it hasn't been translated already.
+ ;; It can happen if it is located in an affiliated
+ ;; keyword that was ignored.
+ (when (and (org-string-nw-p
+ (gethash link (plist-get info :exported-data)))
+ (not (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 (l) (funcall unique-link-p l)) info nil nil t)))
+
+(defun org-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-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 desc (org-export-data desc info)
+ (org-element-property :raw-link link)))))
+ (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-ascii--fill-string
+ (format
+ "[%s] %s"
+ anchor
+ (if (not dest) (org-ascii--translate "Unknown reference" info)
+ (format
+ (org-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-ascii--fill-string
+ (format "[%s] %s" anchor (org-element-property :raw-link link))
+ width info)
+ "\n\n")))))
+ links ""))
+
+(defun org-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-ascii-template--document-title (info)
+ "Return document title, as a string.
+INFO is a plist used as a communication channel."
+ (let* ((text-width org-ascii-text-width)
+ ;; Links in the title will not be resolved later, so we make
+ ;; sure their path is located right after them.
+ (org-ascii-links-to-notes nil)
+ (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 (and (plist-get info :with-date)
+ (org-export-data (org-export-get-date info) 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-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-ascii--fill-string title title-len info))
+ (line
+ (make-string
+ (min (+ (max title-len (length author) (length email)) 2)
+ text-width) (if utf8p ?━ ?_))))
+ (org-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-ascii-inner-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-ascii--indent-string
+ (concat
+ ;; 1. Document's body.
+ contents
+ ;; 2. 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-ascii-links-to-notes nil))
+ (when definitions
+ (concat
+ "\n\n\n"
+ (let ((title (org-ascii--translate "Footnotes" info)))
+ (concat
+ title "\n"
+ (make-string
+ (length title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))))
+ "\n\n"
+ (let ((text-width (- org-ascii-text-width org-ascii-global-margin)))
+ (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-ascii--fill-string
+ (concat id (org-export-data def info))
+ text-width info))))))
+ definitions "\n\n"))))))
+ org-ascii-global-margin)))
+
+(defun org-ascii-template (contents info)
+ "Return complete document string after ASCII conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (concat
+ ;; 1. Build title block.
+ (org-ascii--indent-string
+ (concat (org-ascii-template--document-title info)
+ ;; 2. Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat
+ (org-ascii--build-toc info (and (wholenump depth) depth))
+ "\n\n\n"))))
+ org-ascii-global-margin)
+ ;; 3. Document's body.
+ contents
+ ;; 4. Creator. Ignore `comment' value as there are no comments in
+ ;; ASCII. Justify it to the bottom right.
+ (org-ascii--indent-string
+ (let ((creator-info (plist-get info :with-creator))
+ (text-width (- org-ascii-text-width org-ascii-global-margin)))
+ (unless (or (not creator-info) (eq creator-info 'comment))
+ (concat
+ "\n\n\n"
+ (org-ascii--fill-string
+ (plist-get info :creator) text-width info 'right))))
+ org-ascii-global-margin)))
+
+(defun org-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
+
+;;;; Bold
+
+(defun org-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-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-ascii--justify-string
+ contents (org-ascii--current-text-width center-block info) 'center))
+
+
+;;;; Clock
+
+(defun org-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 :raw-value
+ (org-element-property :value clock)))
+ (let ((time (org-element-property :duration clock)))
+ (and time
+ (concat " => "
+ (apply 'format
+ "%2s:%02s"
+ (org-split-string time ":")))))))
+
+
+;;;; Code
+
+(defun org-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-ascii-verbatim-format (org-element-property :value code)))
+
+
+;;;; Drawer
+
+(defun org-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-ascii--current-text-width drawer info)))
+ (if (functionp org-ascii-format-drawer-function)
+ (funcall org-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-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-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-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-ascii--box-string
+ (org-export-format-code-default example-block info) info))
+
+
+;;;; Export Snippet
+
+(defun org-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) 'ascii)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Export Block
+
+(defun org-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-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-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-ascii-inner-template'.
+
+
+;;;; Footnote Reference
+
+(defun org-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-ascii-headline (headline contents info)
+ "Transcode a 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-ascii--current-text-width headline info))
+ ;; Blank lines between headline and its contents.
+ ;; `org-ascii-headline-spacing', when set, overwrites
+ ;; original buffer's spacing.
+ (pre-blanks
+ (make-string
+ (if org-ascii-headline-spacing (car org-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-ascii--describe-links
+ (org-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-ascii-bullets))))
+ (char-to-string
+ (nth (mod (1- low-level-rank) (length bullets)) bullets)))
+ " "
+ ;; Title.
+ (org-ascii--build-title headline info width) "\n"
+ ;; Contents, indented by length of bullet.
+ pre-blanks
+ (org-ascii--indent-string
+ (concat contents
+ (when (org-string-nw-p links) (concat "\n\n" links)))
+ 2))
+ ;; Else: Standard headline.
+ (concat
+ (org-ascii--build-title headline info width 'underline)
+ "\n" pre-blanks
+ (concat (when (org-string-nw-p links) links) contents))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-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-ascii--current-text-width horizontal-rule info))
+ (spec-width
+ (org-export-read-attribute :attr_ascii horizontal-rule :width)))
+ (org-ascii--justify-string
+ (make-string (if (and spec-width (string-match "^[0-9]+$" spec-width))
+ (string-to-number spec-width)
+ text-width)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?― ?-))
+ text-width 'center)))
+
+
+;;;; Inline Src Block
+
+(defun org-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-ascii-verbatim-format
+ (org-element-property :value inline-src-block)))
+
+
+;;;; Inlinetask
+
+(defun org-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-ascii--current-text-width inlinetask info)))
+ ;; If `org-ascii-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ (if (functionp org-ascii-format-inlinetask-function)
+ (funcall org-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-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-ascii--build-title inlinetask info width)))
+ (if (<= (length title) width) title
+ (org-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-ascii-text-width org-ascii-global-margin
+ (if (not (org-export-get-parent-headline inlinetask)) 0
+ org-ascii-inner-margin)
+ (org-ascii--current-text-width inlinetask info)))))))
+
+
+;;;; Italic
+
+(defun org-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-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-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-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-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-ascii--build-toc
+ info (and (wholenump depth) depth) keyword)))
+ ((string= "tables" value)
+ (org-ascii--list-tables keyword info))
+ ((string= "listings" value)
+ (org-ascii--list-listings keyword info))))))))
+
+
+;;;; Latex Environment
+
+(defun org-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."
+ (when (plist-get info :with-latex)
+ (org-remove-indentation (org-element-property :value latex-environment))))
+
+
+;;;; Latex Fragment
+
+(defun org-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."
+ (when (plist-get info :with-latex)
+ (org-element-property :value latex-fragment)))
+
+
+;;;; Line Break
+
+(defun org-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-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)))
+ (if (org-string-nw-p desc) desc
+ (when destination
+ (let ((number
+ (org-export-get-ordinal
+ destination info nil 'org-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-ascii-links-to-notes (format " (%s)" raw-link))))))))
+
+
+;;;; Paragraph
+
+(defun org-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."
+ (let ((contents (if (not (wholenump org-ascii-indented-line-width)) contents
+ (concat
+ (make-string org-ascii-indented-line-width ? )
+ (replace-regexp-in-string "\\`[ \t]+" "" contents)))))
+ (org-ascii--fill-string
+ contents (org-ascii--current-text-width paragraph info) info)))
+
+
+;;;; Plain List
+
+(defun org-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-ascii-plain-text (text info)
+ "Transcode a TEXT string from Org to ASCII.
+INFO is a plist used as a communication channel."
+ (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
+ (when (and utf8p (plist-get info :with-smart-quotes))
+ (setq text (org-export-activate-smart-quotes text :utf-8 info)))
+ (if (not (plist-get info :with-special-strings)) text
+ (setq text (replace-regexp-in-string "\\\\-" "" text))
+ (if (not utf8p) 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-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
+ (org-element-property :raw-value closed)))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat org-deadline-string " "
+ (org-translate-time
+ (org-element-property :raw-value deadline)))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat org-scheduled-string " "
+ (org-translate-time
+ (org-element-property :raw-value scheduled)))))))
+ " "))
+
+
+;;;; Quote Block
+
+(defun org-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."
+ (org-ascii--indent-string contents org-ascii-quote-margin))
+
+
+;;;; Quote Section
+
+(defun org-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-ascii--current-text-width quote-section info))
+ (value
+ (org-export-data
+ (org-remove-indentation (org-element-property :value quote-section))
+ info)))
+ (org-ascii--indent-string
+ value
+ (+ org-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-ascii-inner-margin))))))
+
+
+;;;; Radio Target
+
+(defun org-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-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-ascii--indent-string
+ (concat
+ contents
+ (when org-ascii-links-to-notes
+ ;; Add list of links at the end of SECTION.
+ (let ((links (org-ascii--describe-links
+ (org-ascii--unique-links section info)
+ (org-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-ascii-inner-margin))))
+
+
+;;;; Special Block
+
+(defun org-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-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-ascii--build-caption src-block info))
+ (code (org-export-format-code-default src-block info)))
+ (if (equal code "") ""
+ (concat
+ (when (and caption org-ascii-caption-above) (concat caption "\n"))
+ (org-ascii--box-string code info)
+ (when (and caption (not org-ascii-caption-above))
+ (concat "\n" caption))))))
+
+
+;;;; Statistics Cookie
+
+(defun org-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-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-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-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-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-ascii--build-caption table info)))
+ (concat
+ ;; Possibly add a caption string above.
+ (when (and caption org-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-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.
+ (and (not org-ascii-caption-above) caption))))
+
+
+;;;; Table Cell
+
+(defun org-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-ascii-table-widen-columns' is non-nil, width cookies
+are ignored."
+ (let* ((row (org-export-get-parent table-cell))
+ (table (org-export-get-parent row))
+ (col (let ((cells (org-element-contents row)))
+ (- (length cells) (length (memq table-cell cells)))))
+ (cache
+ (or (plist-get info :ascii-table-cell-width-cache)
+ (plist-get (setq info
+ (plist-put info :ascii-table-cell-width-cache
+ (make-hash-table :test 'equal)))
+ :ascii-table-cell-width-cache)))
+ (key (cons table col)))
+ (or (gethash key cache)
+ (puthash
+ key
+ (or (and (not org-ascii-table-widen-columns)
+ (org-export-table-cell-width table-cell info))
+ (let* ((max-width 0))
+ (org-element-map table 'table-row
+ (lambda (row)
+ (setq max-width
+ (max (length
+ (org-export-data
+ (org-element-contents
+ (elt (org-element-contents row) col))
+ info))
+ max-width)))
+ info)
+ max-width))
+ cache))))
+
+(defun org-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-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-ascii--table-cell-width table-cell info)))
+ ;; When contents are too large, truncate them.
+ (unless (or org-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-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-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-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 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 "+" "-" "+" "+")))))))
+
+
+;;;; Timestamp
+
+(defun org-ascii-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-ascii-plain-text (org-timestamp-translate timestamp) info))
+
+
+;;;; Underline
+
+(defun org-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-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-ascii-verbatim-format
+ (org-element-property :value verbatim)))
+
+
+;;;; Verse Block
+
+(defun org-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-ascii--current-text-width verse-block info)))
+ (org-ascii--indent-string
+ (org-ascii--justify-string contents verse-width 'left)
+ org-ascii-quote-margin)))
+
+
+
+;;; Filters
+
+(defun org-ascii-filter-headline-blank-lines (headline back-end info)
+ "Filter controlling number of blank lines after a 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 `ascii' back-end. See
+`org-ascii-headline-spacing' for information."
+ (if (not org-ascii-headline-spacing) headline
+ (let ((blanks (make-string (1+ (cdr org-ascii-headline-spacing)) ?\n)))
+ (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))))
+
+(defun org-ascii-filter-paragraph-spacing (tree back-end info)
+ "Filter controlling number of blank lines between paragraphs.
+
+TREE is the parse tree. BACK-END is the symbol specifying
+back-end used for export. INFO is a plist used as
+a communication channel.
+
+See `org-ascii-paragraph-spacing' for information."
+ (when (wholenump org-ascii-paragraph-spacing)
+ (org-element-map tree 'paragraph
+ (lambda (p)
+ (when (eq (org-element-type (org-export-get-next-element p info))
+ 'paragraph)
+ (org-element-put-property
+ p :post-blank org-ascii-paragraph-spacing)))))
+ tree)
+
+(defun org-ascii-filter-comment-spacing (tree backend info)
+ "Filter removing blank lines between comments.
+TREE is the parse tree. BACK-END is the symbol specifying
+back-end used for export. INFO is a plist used as
+a communication channel."
+ (org-element-map tree '(comment comment-block)
+ (lambda (c)
+ (when (memq (org-element-type (org-export-get-next-element c info))
+ '(comment comment-block))
+ (org-element-put-property c :post-blank 0))))
+ tree)
+
+
+
+;;; End-user functions
+
+;;;###autoload
+(defun org-ascii-export-as-ascii
+ (&optional async 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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+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 and
+table of contents 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 ASCII Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (org-export-to-buffer 'ascii "*Org ASCII Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (text-mode))))
+
+;;;###autoload
+(defun org-ascii-export-to-ascii
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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 and
+table of contents from output.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return output file's name."
+ (interactive)
+ (let ((file (org-export-output-file-name ".txt" subtreep)))
+ (org-export-to-file 'ascii file
+ async subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-ascii-publish-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-publish-org-to
+ 'ascii filename ".txt" `(:ascii-charset ascii ,@plist) pub-dir))
+
+;;;###autoload
+(defun org-ascii-publish-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-publish-org-to
+ 'ascii filename ".txt" `(:ascii-charset latin1 ,@plist) pub-dir))
+
+;;;###autoload
+(defun org-ascii-publish-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-publish-org-to
+ 'ascii filename ".txt" `(:ascii-charset utf-8 ,@plist) pub-dir))
+
+
+(provide 'ox-ascii)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; coding: utf-8-emacs
+;; End:
+
+;;; ox-ascii.el ends here
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
new file mode 100644
index 0000000000..c5074f6819
--- /dev/null
+++ b/lisp/org/ox-beamer.el
@@ -0,0 +1,1179 @@
+;;; ox-beamer.el --- Beamer Back-End for Org Export Engine
+
+;; Copyright (C) 2007-2013 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. See Org manual for more information.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox-latex)
+
+;; Install a default set-up for Beamer export.
+(unless (assoc "beamer" org-latex-classes)
+ (add-to-list 'org-latex-classes
+ '("beamer"
+ "\\documentclass[presentation]{beamer}
+\[DEFAULT-PACKAGES]
+\[PACKAGES]
+\[EXTRA]"
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))))
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-beamer nil
+ "Options specific for using the beamer class in LaTeX export."
+ :tag "Org Beamer"
+ :group 'org-export
+ :version "24.2")
+
+(defcustom org-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 a 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 a headline
+within the parse tree, defined as 1."
+ :group 'org-export-beamer
+ :type 'integer)
+
+(defcustom org-beamer-frame-default-options ""
+ "Default options string to use for frames.
+For example, it could be set to \"allowframebreaks\"."
+ :group 'org-export-beamer
+ :type '(string :tag "[options]"))
+
+(defcustom org-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-beamer
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not insert Beamer column view format" nil)
+ (string :tag "Beamer column view format")))
+
+(defcustom org-beamer-theme "default"
+ "Default theme used in Beamer presentations."
+ :group 'org-export-beamer
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not insert a Beamer theme" nil)
+ (string :tag "Beamer theme")))
+
+(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
+ %r the raw headline text (i.e. without any processing)
+ %H if there is headline text, that raw text in {} braces
+ %U if there is headline text, that raw text in [] brackets
+close The closing string of the environment."
+ :group 'org-export-beamer
+ :version "24.4"
+ :package-version '(Org . "8.1")
+ :type '(repeat
+ (list
+ (string :tag "Environment")
+ (string :tag "Selection key")
+ (string :tag "Begin")
+ (string :tag "End"))))
+
+(defcustom org-beamer-outline-frame-title "Outline"
+ "Default title of a frame containing an outline."
+ :group 'org-export-beamer
+ :type '(string :tag "Outline frame title"))
+
+(defcustom org-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-beamer
+ :type '(string :tag "Outline frame options"))
+
+
+
+;;; Internal Variables
+
+(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-environments-special
+ '(("againframe" "A")
+ ("appendix" "x")
+ ("column" "c")
+ ("columns" "C")
+ ("frame" "f")
+ ("fullframe" "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-beamer-select-environment'. Environments listed here,
+along with their binding, are hard coded and cannot be modified
+through `org-beamer-environments-extra' variable.")
+
+(defconst org-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-beamer-environments-extra'.")
+
+(defconst org-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-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-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
+`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 'beamer 'latex
+ :export-block "BEAMER"
+ :menu-entry
+ '(?l 1
+ ((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex)
+ (?b "As LaTeX file (Beamer)" org-beamer-export-to-latex)
+ (?P "As PDF file (Beamer)" org-beamer-export-to-pdf)
+ (?O "As PDF file and open (Beamer)"
+ (lambda (a s v b)
+ (if a (org-beamer-export-to-pdf t s v b)
+ (org-open-file (org-beamer-export-to-pdf nil s v b)))))))
+ :options-alist
+ '((:beamer-theme "BEAMER_THEME" nil org-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)
+ (:beamer-header-extra "BEAMER_HEADER" nil nil newline)
+ ;; Modify existing properties.
+ (:headline-levels nil "H" org-beamer-frame-level)
+ (:latex-class "LATEX_CLASS" nil "beamer" t))
+ :translate-alist '((bold . org-beamer-bold)
+ (export-block . org-beamer-export-block)
+ (export-snippet . org-beamer-export-snippet)
+ (headline . org-beamer-headline)
+ (item . org-beamer-item)
+ (keyword . org-beamer-keyword)
+ (link . org-beamer-link)
+ (plain-list . org-beamer-plain-list)
+ (radio-target . org-beamer-radio-target)
+ (target . org-beamer-target)
+ (template . org-beamer-template)))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-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-beamer--element-has-overlay-p bold) "")
+ contents))
+
+
+;;;; Export Block
+
+(defun org-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-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 "latex" and "beamer" snippets are retained.
+ (cond ((eq backend 'latex) value)
+ ;; Ignore "beamer" snippets specifying overlays.
+ ((and (eq backend 'beamer)
+ (or (org-export-get-previous-element export-snippet info)
+ (not (string-match "\\`<.*>\\'" value))))
+ value))))
+
+
+;;;; Headline
+;;
+;; The main function to translate a headline is
+;; `org-beamer-headline'.
+;;
+;; Depending on the level at which a headline is considered as
+;; a frame (given by `org-beamer--frame-level'), the headline is
+;; either a section (`org-beamer--format-section'), a frame
+;; (`org-beamer--format-frame') or a block
+;; (`org-beamer--format-block').
+;;
+;; `org-beamer-headline' also takes care of special environments
+;; like "ignoreheading", "note", "noteNH", "appendix" and
+;; "againframe".
+
+(defun org-beamer--get-label (headline info)
+ "Return label for HEADLINE, as a string.
+
+INFO is a plist used as a communication channel.
+
+The value is either the label specified in \"BEAMER_opt\"
+property, or a fallback value built from headline's number. This
+function assumes HEADLINE will be treated as a frame."
+ (let ((opt (org-element-property :BEAMER_OPT headline)))
+ (if (and (org-string-nw-p opt)
+ (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt))
+ (match-string 1 opt)
+ (format "sec-%s"
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number headline info)
+ "-")))))
+
+(defun org-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)
+ (let ((env (org-element-property :BEAMER_ENV parent)))
+ (when (and env (member-ignore-case env '("frame" "fullframe")))
+ (throw 'exit (org-export-get-relative-level parent info)))))
+ (nreverse (org-export-get-genealogy headline)))
+ nil)
+ ;; 2. Look for "frame" environment in HEADLINE.
+ (let ((env (org-element-property :BEAMER_ENV headline)))
+ (and env (member-ignore-case env '("frame" "fullframe"))
+ (org-export-get-relative-level headline info)))
+ ;; 3. Look for "frame" environment in sub-tree.
+ (org-element-map headline 'headline
+ (lambda (hl)
+ (let ((env (org-element-property :BEAMER_ENV hl)))
+ (when (and env (member-ignore-case env '("frame" "fullframe")))
+ (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-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."
+ (let ((latex-headline
+ (org-export-with-backend
+ ;; We create a temporary export back-end which behaves the
+ ;; same as current one, but adds "\protect" in front of the
+ ;; output of some objects.
+ (org-export-create-backend
+ :parent 'latex
+ :transcoders
+ (let ((protected-output
+ (function
+ (lambda (object contents info)
+ (let ((code (org-export-with-backend
+ 'beamer object contents info)))
+ (if (org-string-nw-p code) (concat "\\protect" code)
+ code))))))
+ (mapcar #'(lambda (type) (cons type protected-output))
+ '(bold footnote-reference italic strike-through timestamp
+ underline))))
+ headline
+ contents
+ info))
+ (mode-specs (org-element-property :BEAMER_ACT headline)))
+ (if (and mode-specs
+ (string-match "\\`\\\\\\(.*?\\)\\(?:\\*\\|\\[.*\\]\\)?{"
+ latex-headline))
+ ;; Insert overlay specifications.
+ (replace-match (concat (match-string 1 latex-headline)
+ (format "<%s>" mode-specs))
+ nil nil latex-headline 1)
+ latex-headline)))
+
+(defun org-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-beamer-verbatim-elements'.
+ (org-element-map headline org-beamer-verbatim-elements 'identity
+ info 'first-match)))
+ (concat "\\begin{frame}"
+ ;; Overlay specification, if any. When 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-beamer--normalize-argument action 'defaction))
+ (t (org-beamer--normalize-argument action 'action))))
+ ;; Options, if any.
+ (let* ((beamer-opt (org-element-property :BEAMER_OPT headline))
+ (options
+ ;; Collect options from default value and headline's
+ ;; properties. Also add a label for links.
+ (append
+ (org-split-string org-beamer-frame-default-options ",")
+ (and beamer-opt
+ (org-split-string
+ ;; Remove square brackets if user provided
+ ;; them.
+ (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt)
+ (match-string 1 beamer-opt))
+ ","))
+ ;; Provide an automatic label for the frame
+ ;; unless the user specified one.
+ (unless (and beamer-opt
+ (string-match "\\(^\\|,\\)label=" beamer-opt))
+ (list
+ (format "label=%s"
+ (org-beamer--get-label headline info)))))))
+ ;; Change options list into a string.
+ (org-beamer--normalize-argument
+ (mapconcat
+ 'identity
+ (if (or (not fragilep) (member "fragile" options)) options
+ (cons "fragile" options))
+ ",")
+ 'option))
+ ;; Title.
+ (let ((env (org-element-property :BEAMER_ENV headline)))
+ (format "{%s}"
+ (if (and env (equal (downcase env) "fullframe")) ""
+ (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*" "\\& " (or contents "")))
+ "\\end{frame}")))
+
+(defun org-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 "column".
+ (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) "column")
+ ;; Use specified environment.
+ (t env))))
+ (raw-title (org-element-property :raw-value headline))
+ (env-format
+ (cond ((member environment '("column" "columns")) nil)
+ ((assoc environment
+ (append org-beamer-environments-extra
+ org-beamer-environments-default)))
+ (t (user-error "Wrong block type at a headline named \"%s\""
+ raw-title))))
+ (title (org-export-data (org-element-property :title headline) info))
+ (options (let ((options (org-element-property :BEAMER_OPT headline)))
+ (if (not options) ""
+ (org-beamer--normalize-argument options 'option))))
+ ;; Start a "columns" environment when explicitly requested or
+ ;; when there is no previous headline or the previous
+ ;; headline do not have a BEAMER_column property.
+ (parent-env (org-element-property
+ :BEAMER_ENV (org-export-get-parent-headline headline)))
+ (start-columns-p
+ (or (equal environment "columns")
+ (and column-width
+ (not (and parent-env
+ (equal (downcase parent-env) "columns")))
+ (or (org-export-first-sibling-p headline info)
+ (not (org-element-property
+ :BEAMER_COL
+ (org-export-get-previous-element
+ headline info)))))))
+ ;; End the "columns" environment when explicitly requested or
+ ;; when there is no next headline or the next headline do not
+ ;; have a BEAMER_column property.
+ (end-columns-p
+ (or (equal environment "columns")
+ (and column-width
+ (not (and parent-env
+ (equal (downcase parent-env) "columns")))
+ (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
+ ;; Column can accept options only when the environment is
+ ;; explicitly defined.
+ (if (not (equal environment "columns")) "\\begin{columns}\n"
+ (format "\\begin{columns}%s\n" options)))
+ (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 (equal environment "column") options "")
+ (format "%s\\textwidth" column-width)))
+ ;; Block's opening string.
+ (when (nth 2 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-beamer--normalize-argument action 'defaction))
+ (cons "a" "")))
+ (t
+ (list (cons "a" (org-beamer--normalize-argument action 'action))
+ (cons "A" "")))))
+ (list (cons "o" options)
+ (cons "h" title)
+ (cons "r" raw-title)
+ (cons "H" (if (equal raw-title "") ""
+ (format "{%s}" raw-title)))
+ (cons "U" (if (equal raw-title "") ""
+ (format "[%s]" raw-title))))))
+ "\n"))
+ contents
+ ;; Block's closing string, if any.
+ (and (nth 3 env-format) (concat (nth 3 env-format) "\n"))
+ (when column-width "\\end{column}\n")
+ (when end-columns-p "\\end{columns}"))))
+
+(defun org-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-beamer--frame-level headline info))
+ (environment (let ((env (org-element-property :BEAMER_ENV headline)))
+ (or (org-string-nw-p env) "block"))))
+ (cond
+ ;; Case 1: Resume frame specified by "BEAMER_ref" property.
+ ((equal environment "againframe")
+ (let ((ref (org-element-property :BEAMER_REF headline)))
+ ;; Reference to frame being resumed is mandatory. Ignore
+ ;; the whole headline if it isn't provided.
+ (when (org-string-nw-p ref)
+ (concat "\\againframe"
+ ;; Overlay specification.
+ (let ((overlay (org-element-property :BEAMER_ACT headline)))
+ (when overlay
+ (org-beamer--normalize-argument
+ overlay
+ (if (string-match "^\\[.*\\]$" overlay) 'defaction
+ 'action))))
+ ;; Options.
+ (let ((options (org-element-property :BEAMER_OPT headline)))
+ (when options
+ (org-beamer--normalize-argument options 'option)))
+ ;; Resolve reference provided by "BEAMER_ref"
+ ;; property. This is done by building a minimal fake
+ ;; link and calling the appropriate resolve function,
+ ;; depending on the reference syntax.
+ (let* ((type
+ (progn
+ (string-match "^\\(id:\\|#\\|\\*\\)?\\(.*\\)" ref)
+ (cond
+ ((or (not (match-string 1 ref))
+ (equal (match-string 1 ref) "*")) 'fuzzy)
+ ((equal (match-string 1 ref) "id:") 'id)
+ (t 'custom-id))))
+ (link (list 'link (list :path (match-string 2 ref))))
+ (target (if (eq type 'fuzzy)
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ ;; Now use user-defined label provided in TARGET
+ ;; headline, or fallback to standard one.
+ (format "{%s}" (org-beamer--get-label target info)))))))
+ ;; Case 2: 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))
+ ;; Case 3: Ignore heading.
+ ((equal environment "ignoreheading")
+ (concat (make-string (org-element-property :pre-blank headline) ?\n)
+ contents))
+ ;; Case 4: 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))))
+ ;; Case 5: HEADLINE is a frame.
+ ((= level frame-level)
+ (org-beamer--format-frame headline contents info))
+ ;; Case 6: Regular section, extracted from
+ ;; `org-latex-classes'.
+ ((< level frame-level)
+ (org-beamer--format-section headline contents info))
+ ;; Case 7: Otherwise, HEADLINE is a block.
+ (t (org-beamer--format-block headline contents info))))))
+
+
+;;;; Item
+
+(defun org-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-beamer--element-has-overlay-p first-element))))
+ (output (org-export-with-backend 'latex 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-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 `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
+ (when (wholenump depth) (format "\\setcounter{tocdepth}{%s}\n" depth))
+ "\\tableofcontents" options)))
+ (t (org-export-with-backend 'latex keyword contents info)))))
+
+
+;;;; Link
+
+(defun org-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-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-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-beamer--element-has-overlay-p link) "")
+ path
+ contents))))))))
+ ;; Otherwise, use `latex' back-end.
+ (t (org-export-with-backend 'latex link contents info)))))
+
+
+;;;; Plain List
+;;
+;; Plain lists support `:environment', `:overlay' and `:options'
+;; attributes.
+
+(defun org-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-combine-plists
+ (org-export-read-attribute :attr_latex plain-list)
+ (org-export-read-attribute :attr_beamer plain-list)))
+ (latex-type (let ((env (plist-get attributes :environment)))
+ (cond (env)
+ ((eq type 'ordered) "enumerate")
+ ((eq type 'descriptive) "description")
+ (t "itemize")))))
+ (org-latex--wrap-label
+ plain-list
+ (format "\\begin{%s}%s%s\n%s\\end{%s}"
+ latex-type
+ ;; Default overlay specification, if any.
+ (org-beamer--normalize-argument
+ (or (plist-get attributes :overlay) "")
+ 'defaction)
+ ;; Second optional argument depends on the list type.
+ (org-beamer--normalize-argument
+ (or (plist-get attributes :options) "")
+ 'option)
+ ;; Eventually insert contents and close environment.
+ contents
+ latex-type))))
+
+
+;;;; Radio Target
+
+(defun org-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-beamer--element-has-overlay-p radio-target) "")
+ (org-export-solidify-link-text
+ (org-element-property :value radio-target))
+ text))
+
+
+;;;; Target
+
+(defun org-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 `latex' back-end,
+;; excepted for the table of contents and Beamer themes.
+
+(defun org-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))
+ (header (nth 1 (assoc class org-latex-classes)))
+ (document-class-string
+ (and (stringp header)
+ (if (not class-options) header
+ (replace-regexp-in-string
+ "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
+ class-options header t nil 1)))))
+ (if (not document-class-string)
+ (user-error "Unknown LaTeX class `%s'" class)
+ (org-latex-guess-babel-language
+ (org-latex-guess-inputenc
+ (org-element-normalize-string
+ (org-splice-latex-header
+ document-class-string
+ org-latex-default-packages-alist
+ org-latex-packages-alist nil
+ (concat (org-element-normalize-string
+ (plist-get info :latex-header))
+ (org-element-normalize-string
+ (plist-get info :latex-header-extra))
+ (plist-get info :beamer-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.
+ (let ((date (and (plist-get info :with-date) (org-export-get-date info))))
+ (format "\\date{%s}\n" (org-export-data date info)))
+ ;; 7. Title
+ (format "\\title{%s}\n" title)
+ ;; 8. Hyperref options.
+ (when (plist-get info :latex-hyperref-p)
+ (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-latex-title-command)) nil)
+ ((string-match "\\(?:[^%]\\|^\\)%s"
+ org-latex-title-command)
+ (format org-latex-title-command title))
+ (t org-latex-title-command)))
+ ;; 11. Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat
+ (format "\\begin{frame}%s{%s}\n"
+ (org-beamer--normalize-argument
+ org-beamer-outline-frame-options 'option)
+ org-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-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)
+
+;;;###autoload
+(define-minor-mode org-beamer-mode
+ "Support for editing Beamer oriented Org mode files."
+ nil " Bm" 'org-beamer-mode-map)
+
+(when (fboundp 'font-lock-add-keywords)
+ (font-lock-add-keywords
+ 'org-mode
+ '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend))
+ 'prepend))
+
+(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40))))
+ "The special face for beamer tags."
+ :group 'org-export-beamer)
+
+(defun org-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)
+ ;; Filter out Beamer-related tags and install environment tag.
+ (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x))
+ (org-get-tags)))
+ (env-tag (and (org-string-nw-p value) (concat "B_" value))))
+ (org-set-tags-to (if env-tag (cons env-tag tags) tags))
+ (when env-tag (org-toggle-tag env-tag 'on)))))
+ ((equal property "BEAMER_col")
+ (org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off)))))
+
+(add-hook 'org-property-changed-functions 'org-beamer-property-changed)
+
+(defun org-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-beamer-environments-special
+ 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
+ (org-split-string org-beamer-column-widths " "))))
+
+(add-hook 'org-property-allowed-value-functions
+ 'org-beamer-allowed-property-values)
+
+
+
+;;; Commands
+
+;;;###autoload
+(defun org-beamer-export-as-latex
+ (&optional async 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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+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 BEAMER Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (org-export-to-buffer 'beamer "*Org BEAMER Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+
+;;;###autoload
+(defun org-beamer-export-to-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return output file's name."
+ (interactive)
+ (let ((file (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'beamer file
+ async subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-beamer-export-to-pdf
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return PDF file's name."
+ (interactive)
+ (let ((file (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'beamer file
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
+
+;;;###autoload
+(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)
+ ;; Make sure `org-beamer-environments-special' has a higher
+ ;; priority than `org-beamer-environments-extra'.
+ (let* ((envs (append org-beamer-environments-special
+ 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
+ ;; For a column, automatically ask for its width.
+ ((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")))
+ ;; For an "againframe" section, automatically ask for reference
+ ;; to resumed frame and overlay specifications.
+ ((eq org-last-tag-selection-key ?A)
+ (if (equal (org-entry-get nil "BEAMER_env") "againframe")
+ (progn (org-entry-delete nil "BEAMER_env")
+ (org-entry-delete nil "BEAMER_ref")
+ (org-entry-delete nil "BEAMER_act"))
+ (org-entry-put nil "BEAMER_env" "againframe")
+ (org-set-property
+ "BEAMER_ref"
+ (read-string "Frame reference (*Title, #custom-id, id:...): "))
+ (org-set-property "BEAMER_act"
+ (read-string "Overlay specification: "))))
+ ((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-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-beamer-column-view-format
+ (org-entry-put nil "COLUMNS" org-beamer-column-view-format))
+ (org-entry-put nil "BEAMER_col_ALL" org-beamer-column-widths))
+ (insert "#+LaTeX_CLASS: beamer\n")
+ (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n")
+ (when org-beamer-theme (insert "#+BEAMER_THEME: " org-beamer-theme "\n"))
+ (when org-beamer-column-view-format
+ (insert "#+COLUMNS: " org-beamer-column-view-format "\n"))
+ (insert "#+PROPERTY: BEAMER_col_ALL " org-beamer-column-widths "\n")))
+
+;;;###autoload
+(defun org-beamer-publish-to-latex (plist filename pub-dir)
+ "Publish an Org file to a Beamer presentation (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-publish-org-to 'beamer filename ".tex" plist pub-dir))
+
+;;;###autoload
+(defun org-beamer-publish-to-pdf (plist filename pub-dir)
+ "Publish an Org file to a Beamer presentation (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."
+ ;; Unlike to `org-beamer-publish-to-latex', PDF file is generated in
+ ;; working directory and then moved to publishing directory.
+ (org-publish-attachment
+ plist
+ (org-latex-compile (org-publish-org-to 'beamer filename ".tex" plist))
+ pub-dir))
+
+
+(provide 'ox-beamer)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-beamer.el ends here
diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
new file mode 100644
index 0000000000..c47cc8610a
--- /dev/null
+++ b/lisp/org/ox-html.el
@@ -0,0 +1,3427 @@
+;;; ox-html.el --- HTML Back-End for Org Export Engine
+
+;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Jambunathan K <kjambunathan at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 HTML back-end for Org generic exporter.
+;; See Org manual for more information.
+
+;;; Code:
+
+;;; Dependencies
+
+(require 'ox)
+(require 'ox-publish)
+(require 'format-spec)
+(eval-when-compile (require 'cl) (require 'table nil 'noerror))
+
+
+;;; 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))
+(declare-function mm-url-decode-entities "mm-url" ())
+
+;;; Define Back-End
+
+(org-export-define-backend 'html
+ '((bold . org-html-bold)
+ (center-block . org-html-center-block)
+ (clock . org-html-clock)
+ (code . org-html-code)
+ (drawer . org-html-drawer)
+ (dynamic-block . org-html-dynamic-block)
+ (entity . org-html-entity)
+ (example-block . org-html-example-block)
+ (export-block . org-html-export-block)
+ (export-snippet . org-html-export-snippet)
+ (fixed-width . org-html-fixed-width)
+ (footnote-definition . org-html-footnote-definition)
+ (footnote-reference . org-html-footnote-reference)
+ (headline . org-html-headline)
+ (horizontal-rule . org-html-horizontal-rule)
+ (inline-src-block . org-html-inline-src-block)
+ (inlinetask . org-html-inlinetask)
+ (inner-template . org-html-inner-template)
+ (italic . org-html-italic)
+ (item . org-html-item)
+ (keyword . org-html-keyword)
+ (latex-environment . org-html-latex-environment)
+ (latex-fragment . org-html-latex-fragment)
+ (line-break . org-html-line-break)
+ (link . org-html-link)
+ (paragraph . org-html-paragraph)
+ (plain-list . org-html-plain-list)
+ (plain-text . org-html-plain-text)
+ (planning . org-html-planning)
+ (property-drawer . org-html-property-drawer)
+ (quote-block . org-html-quote-block)
+ (quote-section . org-html-quote-section)
+ (radio-target . org-html-radio-target)
+ (section . org-html-section)
+ (special-block . org-html-special-block)
+ (src-block . org-html-src-block)
+ (statistics-cookie . org-html-statistics-cookie)
+ (strike-through . org-html-strike-through)
+ (subscript . org-html-subscript)
+ (superscript . org-html-superscript)
+ (table . org-html-table)
+ (table-cell . org-html-table-cell)
+ (table-row . org-html-table-row)
+ (target . org-html-target)
+ (template . org-html-template)
+ (timestamp . org-html-timestamp)
+ (underline . org-html-underline)
+ (verbatim . org-html-verbatim)
+ (verse-block . org-html-verse-block))
+ :export-block "HTML"
+ :filters-alist '((:filter-options . org-html-infojs-install-script)
+ (:filter-final-output . org-html-final-function))
+ :menu-entry
+ '(?h "Export to HTML"
+ ((?H "As HTML buffer" org-html-export-as-html)
+ (?h "As HTML file" org-html-export-to-html)
+ (?o "As HTML file and open"
+ (lambda (a s v b)
+ (if a (org-html-export-to-html t s v b)
+ (org-open-file (org-html-export-to-html nil s v b)))))))
+ :options-alist
+ '((:html-extension nil nil org-html-extension)
+ (:html-link-org-as-html nil nil org-html-link-org-files-as-html)
+ (:html-doctype "HTML_DOCTYPE" nil org-html-doctype)
+ (:html-container "HTML_CONTAINER" nil org-html-container-element)
+ (:html-html5-fancy nil "html5-fancy" org-html-html5-fancy)
+ (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url)
+ (:html-link-home "HTML_LINK_HOME" nil org-html-link-home)
+ (:html-link-up "HTML_LINK_UP" nil org-html-link-up)
+ (:html-mathjax "HTML_MATHJAX" nil "" space)
+ (:html-postamble nil "html-postamble" org-html-postamble)
+ (:html-preamble nil "html-preamble" org-html-preamble)
+ (:html-head "HTML_HEAD" nil org-html-head newline)
+ (:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline)
+ (:html-head-include-default-style nil "html-style" org-html-head-include-default-style)
+ (:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts)
+ (:html-table-attributes nil nil org-html-table-default-attributes)
+ (:html-table-row-tags nil nil org-html-table-row-tags)
+ (:html-xml-declaration nil nil org-html-xml-declaration)
+ (:html-inline-images nil nil org-html-inline-images)
+ (:infojs-opt "INFOJS_OPT" nil nil)
+ ;; Redefine regular options.
+ (:creator "CREATOR" nil org-html-creator-string)
+ (:with-latex nil "tex" org-html-with-latex)))
+
+
+;;; Internal Variables
+
+(defvar org-html-format-table-no-css)
+(defvar htmlize-buffer-places) ; from htmlize.el
+
+(defvar org-html--pre/postamble-class "status"
+ "CSS class used for pre/postamble")
+
+(defconst org-html-doctype-alist
+ '(("html4-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\"
+\"http://www.w3.org/TR/html4/strict.dtd\">")
+ ("html4-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+\"http://www.w3.org/TR/html4/loose.dtd\">")
+ ("html4-frameset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\"
+\"http://www.w3.org/TR/html4/frameset.dtd\">")
+
+ ("xhtml-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
+ ("xhtml-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">")
+ ("xhtml-framset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">")
+ ("xhtml-11" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml11.dtd\">")
+
+ ("html5" . "<!DOCTYPE html>")
+ ("xhtml5" . "<!DOCTYPE html>"))
+ "An alist mapping (x)html flavors to specific doctypes.")
+
+(defconst org-html-html5-elements
+ '("article" "aside" "audio" "canvas" "details" "figcaption"
+ "figure" "footer" "header" "menu" "meter" "nav" "output"
+ "progress" "section" "video")
+ "New elements in html5.
+
+<hgroup> is not included because it's currently impossible to
+wrap special blocks around multiple headlines. For other blocks
+that should contain headlines, use the HTML_CONTAINER property on
+the headline itself.")
+
+(defconst org-html-special-string-regexps
+ '(("\\\\-" . "&#x00ad;") ; shy
+ ("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
+ ("--\\([^-]\\)" . "&#x2013;\\1") ; ndash
+ ("\\.\\.\\." . "&#x2026;")) ; hellip
+ "Regular expressions for special string conversion.")
+
+(defconst org-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-html-style-default
+ "<style type=\"text/css\">
+ <!--/*--><![CDATA[/*><!--*/
+ .title { text-align: center; }
+ .todo { font-family: monospace; color: red; }
+ .done { color: green; }
+ .tag { background-color: #eee; font-family: monospace;
+ padding: 2px; font-size: 80%; font-weight: normal; }
+ .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; }
+ .underline { text-decoration: underline; }
+ #postamble p, #preamble p { font-size: 90%; margin: .2em; }
+ p.verse { margin-left: 3%; }
+ pre {
+ border: 1px solid #ccc;
+ box-shadow: 3px 3px 3px #eee;
+ padding: 8pt;
+ font-family: monospace;
+ overflow: auto;
+ margin: 1.2em;
+ }
+ pre.src {
+ position: relative;
+ overflow: visible;
+ padding-top: 1.2em;
+ }
+ pre.src:before {
+ display: none;
+ position: absolute;
+ background-color: white;
+ top: -10px;
+ right: 10px;
+ padding: 3px;
+ border: 1px solid black;
+ }
+ pre.src:hover:before { display: inline;}
+ pre.src-sh:before { content: 'sh'; }
+ pre.src-bash:before { content: 'sh'; }
+ pre.src-emacs-lisp:before { content: 'Emacs Lisp'; }
+ pre.src-R:before { content: 'R'; }
+ pre.src-perl:before { content: 'Perl'; }
+ pre.src-java:before { content: 'Java'; }
+ pre.src-sql:before { content: 'SQL'; }
+
+ 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; }
+ .footpara:nth-child(2) { display: inline; }
+ .footpara { display: block; }
+ .footdef { margin-bottom: 1em; }
+ .figure { padding: 1em; }
+ .figure p { text-align: center; }
+ .inlinetask {
+ padding: 10px;
+ border: 2px solid gray;
+ margin: 10px;
+ background: #ffffcc;
+ }
+ #org-div-home-and-up
+ { text-align: right; font-size: 70%; white-space: nowrap; }
+ 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.
+You can use `org-html-head' and `org-html-head-extra' to add to
+this style. If you don't want to include this default style,
+customize `org-html-head-include-default-style'.")
+
+
+;;; User Configuration Variables
+
+(defgroup org-export-html nil
+ "Options for exporting Org mode files to HTML."
+ :tag "Org Export HTML"
+ :group 'org-export)
+
+;;;; Handle infojs
+
+(defvar org-html-infojs-opts-table
+ '((path PATH "http://orgmode.org/org-info.js")
+ (view VIEW "info")
+ (toc TOC :with-toc)
+ (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 :html-link-up)
+ (home LINK_HOME :html-link-home))
+ "JavaScript options, long form for script, default values.")
+
+(defcustom org-html-use-infojs 'when-configured
+ "Non-nil when Sebastian Rose's Java Script org-info.js should be active.
+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-html-infojs-options'."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "When configured in buffer" when-configured)
+ (const :tag "Always" t)))
+
+(defcustom org-html-infojs-options
+ (mapcar (lambda (x) (cons (car x) (nth 2 x))) org-html-infojs-opts-table)
+ "Options settings for the INFOJS JavaScript.
+Each of the options must have an entry in `org-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-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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-html-infojs-opts-table)))
+
+(defcustom org-html-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-2013 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-2013 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-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defun org-html-infojs-install-script (exp-plist backend)
+ "Install script in export options when appropriate.
+EXP-PLIST is a plist containing export options. BACKEND is the
+export back-end currently used."
+ (unless (or (memq 'body-only (plist-get exp-plist :export-options))
+ (not org-html-use-infojs)
+ (and (eq org-html-use-infojs 'when-configured)
+ (or (not (plist-get exp-plist :infojs-opt))
+ (string-match "\\<view:nil\\>"
+ (plist-get exp-plist :infojs-opt)))))
+ (let* ((template org-html-infojs-template)
+ (ptoc (plist-get exp-plist :with-toc))
+ (hlevels (plist-get exp-plist :headline-levels))
+ (sdepth hlevels)
+ (tdepth (if (integerp ptoc) (min ptoc hlevels) hlevels))
+ (options (plist-get exp-plist :infojs-opt))
+ (table org-html-infojs-opts-table)
+ style)
+ (dolist (entry table)
+ (let* ((opt (car entry))
+ (var (nth 1 entry))
+ ;; Compute default values for script option OPT from
+ ;; `org-html-infojs-options' variable.
+ (default
+ (let ((default (cdr (assq opt org-html-infojs-options))))
+ (if (and (symbolp default) (not (memq default '(t nil))))
+ (plist-get exp-plist default)
+ default)))
+ ;; Value set through INFOJS_OPT keyword has precedence
+ ;; over the default one.
+ (val (if (and options
+ (string-match (format "\\<%s:\\(\\S-+\\)" opt)
+ options))
+ (match-string 1 options)
+ default)))
+ (case opt
+ (path (setq template
+ (replace-regexp-in-string
+ "%SCRIPT_PATH" val template t t)))
+ (sdepth (when (integerp (read val))
+ (setq sdepth (min (read val) sdepth))))
+ (tdepth (when (integerp (read val))
+ (setq tdepth (min (read val) tdepth))))
+ (otherwise (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) style)))))
+ ;; 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 :with-toc sdepth))
+ ;; The table of contents should not show more sections than we
+ ;; generate.
+ (setq tdepth (min tdepth sdepth))
+ (push (cons "TOC_DEPTH" tdepth) style)
+ ;; Build style string.
+ (setq style (mapconcat
+ (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
+ (car x)
+ (cdr x)))
+ style "\n"))
+ (when (and style (> (length style) 0))
+ (and (string-match "%MANAGER_OPTIONS" template)
+ (setq style (replace-match style t t template))
+ (setq exp-plist
+ (plist-put
+ exp-plist :html-head-extra
+ (concat (or (plist-get exp-plist :html-head-extra) "")
+ "\n"
+ style)))))
+ ;; This script absolutely needs the table of contents, so we
+ ;; change that setting.
+ (unless (plist-get exp-plist :with-toc)
+ (setq exp-plist (plist-put exp-plist :with-toc t)))
+ ;; Return the modified property list.
+ exp-plist)))
+
+;;;; Bold, etc.
+
+(defcustom org-html-text-markup-alist
+ '((bold . "<b>%s</b>")
+ (code . "<code>%s</code>")
+ (italic . "<i>%s</i>")
+ (strike-through . "<del>%s</del>")
+ (underline . "<span class=\"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-html
+ :type '(alist :key-type (symbol :tag "Markup type")
+ :value-type (string :tag "Format string"))
+ :options '(bold code italic strike-through underline verbatim))
+
+(defcustom org-html-indent nil
+ "Non-nil means to indent the generated HTML.
+Warning: non-nil may break indentation of source code blocks."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-html-use-unicode-chars nil
+ "Non-nil means to use unicode characters instead of HTML entities."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+;;;; Drawers
+
+(defcustom org-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-html-format-drawer-default \(name contents\)
+ \"Format a drawer element for HTML export.\"
+ contents\)"
+ :group 'org-export-html
+ :type 'function)
+
+;;;; Footnotes
+
+(defcustom org-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-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-html-footnote-separator "<sup>, </sup>"
+ "Text used to separate footnotes."
+ :group 'org-export-html
+ :type 'string)
+
+;;;; Headline
+
+(defcustom org-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 'integer)
+
+(defcustom org-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."
+ :group 'org-export-html
+ :type 'function)
+
+;;;; HTML-specific
+
+(defcustom org-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-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+;;;; Inlinetasks
+
+(defcustom org-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."
+ :group 'org-export-html
+ :type 'function)
+
+;;;; LaTeX
+
+(defcustom org-html-with-latex org-export-with-latex
+ "Non-nil means process LaTeX math snippets.
+
+When set, the exporter will process LaTeX environments and
+fragments.
+
+This option can also be set with the +OPTIONS line,
+e.g. \"tex:mathjax\". Allowed values are:
+
+nil Ignore math snippets.
+`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.
+`mathjax' Do MathJax preprocessing and arrange for MathJax.js to
+ be loaded.
+t Synonym for `mathjax'."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not process math in any way" nil)
+ (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)))
+
+;;;; Links :: Generic
+
+(defcustom org-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)
+
+;;;; Links :: Inline images
+
+(defcustom org-html-inline-images t
+ "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."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.1")
+ :type 'boolean)
+
+(defcustom org-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."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+;;;; Plain Text
+
+(defcustom org-html-protect-char-alist
+ '(("&" . "&amp;")
+ ("<" . "&lt;")
+ (">" . "&gt;"))
+ "Alist of characters to be converted by `org-html-protect'."
+ :group 'org-export-html
+ :type '(repeat (cons (string :tag "Character")
+ (string :tag "HTML equivalent"))))
+
+;;;; Src Block
+
+(defcustom org-html-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-html-htmlize-generate-css] to extract class definitions."
+ :group 'org-export-html
+ :type '(choice (const css) (const inline-css)))
+
+(defcustom org-html-htmlize-font-prefix "org-"
+ "The prefix for CSS class names for htmlize font specifications."
+ :group 'org-export-html
+ :type 'string)
+
+;;;; Table
+
+(defcustom org-html-table-default-attributes
+ '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" :frame "hsides")
+ "Default attributes and values which will be used in table tags.
+This is a plist where attributes are symbols, starting with
+colons, and values are strings.
+
+When exporting to HTML5, these values will be disregarded."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(plist :key-type (symbol :tag "Property")
+ :value-type (string :tag "Value")))
+
+(defcustom org-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-html-table-use-header-tags-for-first-column'.
+See also the variable `org-html-table-align-individual-fields'."
+ :group 'org-export-html
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-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-html-table-align-individual-fields'."
+ :group 'org-export-html
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-html-table-row-tags '("<tr>" . "</tr>")
+ "The opening and ending tags for table rows.
+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, these variables will be dynamically bound so that
+you can reuse them:
+
+ `row-number': row number (0 is the first row)
+ `rowgroup-number': group number of current row
+ `start-rowgroup-p': non-nil means the row starts a group
+ `end-rowgroup-p': non-nil means the row ends a group
+ `top-row-p': non-nil means this is the top row
+ `bottom-row-p': non-nil means this is the bottom row
+
+For example:
+
+\(setq org-html-table-row-tags
+ (cons '(cond (top-row-p \"<tr class=\\\"tr-top\\\">\")
+ (bottom-row-p \"<tr class=\\\"tr-bottom\\\">\")
+ (t (if (= (mod row-number 2) 1)
+ \"<tr class=\\\"tr-odd\\\">\"
+ \"<tr class=\\\"tr-even\\\">\")))
+ \"</tr>\"))
+
+will use the \"tr-top\" and \"tr-bottom\" classes for the top row
+and the bottom row, and otherwise alternate between \"tr-odd\" and
+\"tr-even\" for odd and even rows."
+ :group 'org-export-html
+ :type '(cons
+ (choice :tag "Opening tag"
+ (string :tag "Specify")
+ (sexp))
+ (choice :tag "Closing tag"
+ (string :tag "Specify")
+ (sexp))))
+
+(defcustom org-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-html
+ :type 'boolean)
+
+(defcustom org-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-html
+ :type 'boolean)
+
+(defcustom org-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-html
+ :type 'boolean)
+
+;;;; Tags
+
+(defcustom org-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)
+
+;;;; Template :: Generic
+
+(defcustom org-html-extension "html"
+ "The extension for exported HTML files."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-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.
+
+This declaration only applies when exporting to XHTML."
+ :group 'org-export-html
+ :type '(choice
+ (string :tag "Single declaration")
+ (repeat :tag "Dependent on extension"
+ (cons (string :tag "Extension")
+ (string :tag "Declaration")))))
+
+(defcustom org-html-coding-system 'utf-8
+ "Coding system for HTML export.
+Use utf-8 as the default value."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'coding-system)
+
+(defcustom org-html-doctype "xhtml-strict"
+ "Document type definition to use for exported HTML files.
+Can be set with the in-buffer HTML_DOCTYPE property or for
+publishing, with :html-doctype."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-html-html5-fancy nil
+ "Non-nil means using new HTML5 elements.
+This variable is ignored for anything other than HTML5 export.
+
+For compatibility with Internet Explorer, it's probably a good
+idea to download some form of the html5shiv (for instance
+https://code.google.com/p/html5shiv/) and add it to your
+HTML_HEAD_EXTRA, so that your pages don't break for users of IE
+versions 8 and below."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-html-container-element "div"
+ "HTML element to use for wrapping top level sections.
+Can be set with the in-buffer HTML_CONTAINER property or for
+publishing, with :html-container.
+
+Note that changing the default will prevent you from using
+org-info.js for your website."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-html-divs
+ '((preamble "div" "preamble")
+ (content "div" "content")
+ (postamble "div" "postamble"))
+ "Alist of the three section elements for HTML export.
+The car of each entry is one of 'preamble, 'content or 'postamble.
+The cdrs of each entry are the ELEMENT_TYPE and ID for each
+section of the exported document.
+
+Note that changing the default will prevent you from using
+org-info.js for your website."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(list :greedy t
+ (list :tag "Preamble"
+ (const :format "" preamble)
+ (string :tag "element") (string :tag " id"))
+ (list :tag "Content"
+ (const :format "" content)
+ (string :tag "element") (string :tag " id"))
+ (list :tag "Postamble" (const :format "" postamble)
+ (string :tag " id") (string :tag "element"))))
+
+(defcustom org-html-metadata-timestamp-format "%Y-%m-%d %a %H:%M"
+ "Format used for timestamps in preamble, postamble and metadata.
+See `format-time-string' for more information on its components."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+;;;; Template :: Mathjax
+
+(defcustom org-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
+ :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-html-mathjax-template
+ "<script type=\"text/javascript\" src=\"%PATH\"></script>
+<script type=\"text/javascript\">
+<!--/*--><![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
+ :type 'string)
+
+;;;; Template :: Postamble
+
+(defcustom org-html-postamble 'auto
+ "Non-nil means insert a postamble in HTML export.
+
+When set to 'auto, check against the
+`org-export-with-author/email/creator/date' variables to set the
+content of the postamble. When set to a string, use this string
+as the postamble. When t, insert a string as defined by the
+formatting string in `org-html-postamble-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-postamble in publishing projects will take
+precedence over this variable."
+ :group 'org-export-html
+ :type '(choice (const :tag "No postamble" nil)
+ (const :tag "Auto postamble" auto)
+ (const :tag "Default formatting string" t)
+ (string :tag "Custom formatting string")
+ (function :tag "Function (must return a string)")))
+
+(defcustom org-html-postamble-format
+ '(("en" "<p class=\"author\">Author: %a (%e)</p>
+<p class=\"date\">Date: %d</p>
+<p class=\"creator\">%c</p>
+<p class=\"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. See `org-export-default-language'.
+
+The second element of each list is a format string to format the
+postamble 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.
+ %c will be replaced by `org-html-creator-string'.
+ %v will be replaced by `org-html-validation-link'.
+ %T will be replaced by the export time.
+ %C will be replaced by the last modification time.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\"."
+ :group 'org-export-html
+ :type '(repeat
+ (list (string :tag "Language")
+ (string :tag "Format string"))))
+
+(defcustom org-html-validation-link
+ "<a href=\"http://validator.w3.org/check?uri=referer\">Validate</a>"
+ "Link to HTML validation service."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-html-creator-string
+ (format "<a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> %s (<a href=\"http://orgmode.org\">Org</a> mode %s)"
+ emacs-version
+ (if (fboundp 'org-version) (org-version) "unknown version"))
+ "Information about the creator of the HTML document.
+This option can also be set on with the CREATOR keyword."
+ :group 'org-export-html
+ :type '(string :tag "Creator string"))
+
+;;;; Template :: Preamble
+
+(defcustom org-html-preamble t
+ "Non-nil means insert a preamble in HTML export.
+
+When t, insert a string as defined by the formatting string in
+`org-html-preamble-format'. When set to a string, use this
+formatting string instead (see `org-html-postamble-format' for an
+example of such a formatting string).
+
+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-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-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. See `org-export-default-language'.
+
+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.
+ %c will be replaced by `org-html-creator-string'.
+ %v will be replaced by `org-html-validation-link'.
+ %T will be replaced by the export time.
+ %C will be replaced by the last modification time.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\".
+
+See the default value of `org-html-postamble-format' for an
+example."
+ :group 'org-export-html
+ :type '(repeat
+ (list (string :tag "Language")
+ (string :tag "Format string"))))
+
+(defcustom org-html-link-up ""
+ "Where should the \"UP\" link of exported HTML pages lead?"
+ :group 'org-export-html
+ :type '(string :tag "File or URL"))
+
+(defcustom org-html-link-home ""
+ "Where should the \"HOME\" link of exported HTML pages lead?"
+ :group 'org-export-html
+ :type '(string :tag "File or URL"))
+
+(defcustom org-html-link-use-abs-url nil
+ "Should we prepend relative links with HTML_LINK_HOME?"
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.1")
+ :type 'boolean)
+
+(defcustom org-html-home/up-format
+ "<div id=\"org-div-home-and-up\">
+ <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-html-link-up' and
+`org-html-link-home' are empty, the entire snippet will be
+ignored."
+ :group 'org-export-html
+ :type 'string)
+
+;;;; Template :: Scripts
+
+(define-obsolete-variable-alias
+ 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4")
+(defcustom org-html-head-include-scripts t
+ "Non-nil means include the JavaScript snippets in exported HTML files.
+The actual script is defined in `org-html-scripts' and should
+not be modified."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+;;;; Template :: Styles
+
+(define-obsolete-variable-alias
+ 'org-html-style-include-default 'org-html-head-include-default-style "24.4")
+(defcustom org-html-head-include-default-style t
+ "Non-nil means include the default style in exported HTML files.
+The actual style is defined in `org-html-style-default' and
+should not be modified. Use `org-html-head' to use your own
+style information."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+;;;###autoload
+(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp)
+
+(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
+(defcustom org-html-head ""
+ "Org-wide head definitions for exported HTML files.
+
+This variable can contain the full HTML structure to provide a
+style, including the surrounding HTML tags. You can consider
+including 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 want to refer to an external style, 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 use it to add any arbitrary text to the
+header.
+
+You can set this on a per-file basis using #+HTML_HEAD:,
+or for publication projects using the :html-head property."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+;;;###autoload
+(put 'org-html-head 'safe-local-variable 'stringp)
+
+(defcustom org-html-head-extra ""
+ "More head information to add in the HTML output.
+
+You can set this on a per-file basis using #+HTML_HEAD_EXTRA:,
+or for publication projects using the :html-head-extra property."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+;;;###autoload
+(put 'org-html-head-extra 'safe-local-variable 'stringp)
+
+;;;; Todos
+
+(defcustom org-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)
+
+
+;;; Internal Functions
+
+(defun org-html-xhtml-p (info)
+ (let ((dt (downcase (plist-get info :html-doctype))))
+ (string-match-p "xhtml" dt)))
+
+(defun org-html-html5-p (info)
+ (let ((dt (downcase (plist-get info :html-doctype))))
+ (member dt '("html5" "xhtml5" "<!doctype html>"))))
+
+(defun org-html-close-tag (tag attr info)
+ (concat "<" tag " " attr
+ (if (org-html-xhtml-p info) " />" ">")))
+
+(defun org-html-doctype (info)
+ "Return correct html doctype tag from `org-html-doctype-alist',
+or the literal value of :html-doctype from INFO if :html-doctype
+is not found in the alist.
+INFO is a plist used as a communication channel."
+ (let ((dt (plist-get info :html-doctype)))
+ (or (cdr (assoc dt org-html-doctype-alist)) dt)))
+
+(defun org-html--make-attribute-string (attributes)
+ "Return a list of attributes, as a string.
+ATTRIBUTES is a plist where values are either strings or nil. An
+attributes with a nil value will be omitted from the result."
+ (let (output)
+ (dolist (item attributes (mapconcat 'identity (nreverse output) " "))
+ (cond ((null item) (pop output))
+ ((symbolp item) (push (substring (symbol-name item) 1) output))
+ (t (let ((key (car output))
+ (value (replace-regexp-in-string
+ "\"" "&quot;" (org-html-encode-plain-text item))))
+ (setcar output (format "%s=\"%s\"" key value))))))))
+
+(defun org-html--wrap-image (contents info &optional caption label)
+ "Wrap CONTENTS string within an appropriate environment for images.
+INFO is a plist used as a communication channel. When optional
+arguments CAPTION and LABEL are given, use them for caption and
+\"id\" attribute."
+ (let ((html5-fancy (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy))))
+ (format (if html5-fancy "\n<figure%s>%s%s\n</figure>"
+ "\n<div%s class=\"figure\">%s%s\n</div>")
+ ;; ID.
+ (if (not (org-string-nw-p label)) ""
+ (format " id=\"%s\"" (org-export-solidify-link-text label)))
+ ;; Contents.
+ (format "\n<p>%s</p>" contents)
+ ;; Caption.
+ (if (not (org-string-nw-p caption)) ""
+ (format (if html5-fancy "\n<figcaption>%s</figcaption>"
+ "\n<p>%s</p>")
+ caption)))))
+
+(defun org-html--format-image (source attributes info)
+ "Return \"img\" tag with given SOURCE and ATTRIBUTES.
+SOURCE is a string specifying the location of the image.
+ATTRIBUTES is a plist, as returned by
+`org-export-read-attribute'. INFO is a plist used as
+a communication channel."
+ (org-html-close-tag
+ "img"
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (list :src source
+ :alt (if (string-match-p "^ltxpng/" source)
+ (org-html-encode-plain-text
+ (org-find-text-property-in-string 'org-latex-src source))
+ (file-name-nondirectory source)))
+ attributes))
+ info))
+
+(defun org-html--textarea-block (element)
+ "Transcode ELEMENT into a textarea block.
+ELEMENT is either a src block or an example block."
+ (let* ((code (car (org-export-unravel-code element)))
+ (attr (org-export-read-attribute :attr_html element)))
+ (format "<p>\n<textarea cols=\"%s\" rows=\"%s\">\n%s</textarea>\n</p>"
+ (or (plist-get attr :width) 80)
+ (or (plist-get attr :height) (org-count-lines code))
+ code)))
+
+(defun org-html--has-caption-p (element &optional 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' or
+a value to `org-html-standalone-image-predicate'."
+ (org-element-property :caption element))
+
+;;;; Table
+
+(defun org-html-htmlize-region-for-paste (beg end)
+ "Convert the region between BEG and END 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-html-htmlize-output-type)
+ (htmlize-css-name-prefix org-html-htmlize-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-html-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-html-htmlize-output-type' to `css', calls
+to the function `org-html-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--make-string (n string)
+ "Build a string by concatenating N times STRING."
+ (let (out) (dotimes (i n out) (setq out (concat string out)))))
+
+(defun org-html-fix-class-name (kwd) ; audit callers of this function
+ "Turn todo keyword KWD 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-html-format-footnote-reference (n def refcnt)
+ "Format footnote reference N with definition DEF into HTML."
+ (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt))))
+ (format org-html-footnote-format
+ (let* ((id (format "fnr.%s%s" n extra))
+ (href (format " href=\"#fn.%s\"" n))
+ (attributes (concat " class=\"footref\"" href)))
+ (org-html--anchor id n attributes)))))
+
+(defun org-html-format-footnotes-section (section-name definitions)
+ "Format footnotes section SECTION-NAME."
+ (if (not definitions) ""
+ (format org-html-footnotes-section section-name definitions)))
+
+(defun org-html-format-footnote-definition (fn)
+ "Format the footnote definition FN."
+ (let ((n (car fn)) (def (cdr fn)))
+ (format
+ "<div class=\"footdef\">%s %s</div>\n"
+ (format org-html-footnote-format
+ (let* ((id (format "fn.%s" n))
+ (href (format " href=\"#fnr.%s\"" n))
+ (attributes (concat " class=\"footnum\"" href)))
+ (org-html--anchor id n attributes)))
+ def)))
+
+(defun org-html-footnote-section (info)
+ "Format the footnote section.
+INFO is a plist used as a communication channel."
+ (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-html-format-footnotes-section
+ (org-html--translate "Footnotes" info)
+ (format
+ "\n%s\n"
+ (mapconcat 'org-html-format-footnote-definition fn-alist "\n"))))))
+
+
+;;; Template
+
+(defun org-html--build-meta-info (info)
+ "Return meta tags for exported document.
+INFO is a plist used as a communication channel."
+ (let ((protect-string
+ (lambda (str)
+ (replace-regexp-in-string
+ "\"" "&quot;" (org-html-encode-plain-text str))))
+ (title (org-export-data (plist-get info :title) info))
+ (author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth
+ ;; Return raw Org syntax, skipping non
+ ;; exportable objects.
+ (org-element-interpret-data
+ (org-element-map auth
+ (cons 'plain-text org-element-all-objects)
+ 'identity info))))))
+ (description (plist-get info :description))
+ (keywords (plist-get info :keywords))
+ (charset (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-html-coding-system
+ 'mime-charset))
+ "iso-8859-1")))
+ (concat
+ (format "<title>%s</title>\n" title)
+ (when (plist-get info :time-stamp-file)
+ (format-time-string
+ (concat "<!-- " org-html-metadata-timestamp-format " -->\n")))
+ (format
+ (if (org-html-html5-p info)
+ (org-html-close-tag "meta" " charset=\"%s\"" info)
+ (org-html-close-tag
+ "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\""
+ info))
+ charset) "\n"
+ (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info)
+ "\n"
+ (and (org-string-nw-p author)
+ (concat
+ (org-html-close-tag "meta"
+ (format " name=\"author\" content=\"%s\""
+ (funcall protect-string author))
+ info)
+ "\n"))
+ (and (org-string-nw-p description)
+ (concat
+ (org-html-close-tag "meta"
+ (format " name=\"description\" content=\"%s\"\n"
+ (funcall protect-string description))
+ info)
+ "\n"))
+ (and (org-string-nw-p keywords)
+ (concat
+ (org-html-close-tag "meta"
+ (format " name=\"keywords\" content=\"%s\""
+ (funcall protect-string keywords))
+ info)
+ "\n")))))
+
+(defun org-html--build-head (info)
+ "Return information for the <head>..</head> of the HTML output.
+INFO is a plist used as a communication channel."
+ (org-element-normalize-string
+ (concat
+ (when (plist-get info :html-head-include-default-style)
+ (org-element-normalize-string org-html-style-default))
+ (org-element-normalize-string (plist-get info :html-head))
+ (org-element-normalize-string (plist-get info :html-head-extra))
+ (when (and (plist-get info :html-htmlized-css-url)
+ (eq org-html-htmlize-output-type 'css))
+ (org-html-close-tag "link"
+ (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\""
+ (plist-get info :html-htmlized-css-url))
+ info))
+ (when (plist-get info :html-head-include-scripts) org-html-scripts))))
+
+(defun org-html--build-mathjax-config (info)
+ "Insert the user setup into the mathjax template.
+INFO is a plist used as a communication channel."
+ (when (and (memq (plist-get info :with-latex) '(mathjax t))
+ (org-element-map (plist-get info :parse-tree)
+ '(latex-fragment latex-environment) 'identity info t))
+ (let ((template org-html-mathjax-template)
+ (options org-html-mathjax-options)
+ (in-buffer (or (plist-get info :html-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.
+ (org-element-normalize-string template))))
+
+(defun org-html-format-spec (info)
+ "Return format specification for elements that can be
+used in the preamble or postamble."
+ `((?t . ,(org-export-data (plist-get info :title) info))
+ (?d . ,(org-export-data (org-export-get-date info) info))
+ (?T . ,(format-time-string org-html-metadata-timestamp-format))
+ (?a . ,(org-export-data (plist-get info :author) info))
+ (?e . ,(mapconcat
+ (lambda (e)
+ (format "<a href=\"mailto:%s\">%s</a>" e e))
+ (split-string (plist-get info :email) ",+ *")
+ ", "))
+ (?c . ,(plist-get info :creator))
+ (?C . ,(let ((file (plist-get info :input-file)))
+ (format-time-string org-html-metadata-timestamp-format
+ (if file (nth 5 (file-attributes file))
+ (current-time)))))
+ (?v . ,(or org-html-validation-link ""))))
+
+(defun org-html--build-pre/postamble (type info)
+ "Return document preamble or postamble as a string, or nil.
+TYPE is either 'preamble or 'postamble, INFO is a plist used as a
+communication channel."
+ (let ((section (plist-get info (intern (format ":html-%s" type))))
+ (spec (org-html-format-spec info)))
+ (when section
+ (let ((section-contents
+ (if (functionp section) (funcall section info)
+ (cond
+ ((stringp section) (format-spec section spec))
+ ((eq section 'auto)
+ (let ((date (cdr (assq ?d spec)))
+ (author (cdr (assq ?a spec)))
+ (email (cdr (assq ?e spec)))
+ (creator (cdr (assq ?c spec)))
+ (timestamp (cdr (assq ?T spec)))
+ (validation-link (cdr (assq ?v spec))))
+ (concat
+ (when (and (plist-get info :with-date)
+ (org-string-nw-p date))
+ (format "<p class=\"date\">%s: %s</p>\n"
+ (org-html--translate "Date" info)
+ date))
+ (when (and (plist-get info :with-author)
+ (org-string-nw-p author))
+ (format "<p class=\"author\">%s: %s</p>\n"
+ (org-html--translate "Author" info)
+ author))
+ (when (and (plist-get info :with-email)
+ (org-string-nw-p email))
+ (format "<p class=\"email\">%s: %s</p>\n"
+ (org-html--translate "Email" info)
+ email))
+ (when (plist-get info :time-stamp-file)
+ (format
+ "<p class=\"date\">%s: %s</p>\n"
+ (org-html--translate "Created" info)
+ (format-time-string org-html-metadata-timestamp-format)))
+ (when (plist-get info :with-creator)
+ (format "<p class=\"creator\">%s</p>\n" creator))
+ (format "<p class=\"validation\">%s</p>\n"
+ validation-link))))
+ (t (format-spec
+ (or (cadr (assoc
+ (plist-get info :language)
+ (eval (intern
+ (format "org-html-%s-format" type)))))
+ (cadr
+ (assoc
+ "en"
+ (eval
+ (intern (format "org-html-%s-format" type))))))
+ spec))))))
+ (when (org-string-nw-p section-contents)
+ (concat
+ (format "<%s id=\"%s\" class=\"%s\">\n"
+ (nth 1 (assq type org-html-divs))
+ (nth 2 (assq type org-html-divs))
+ org-html--pre/postamble-class)
+ (org-element-normalize-string section-contents)
+ (format "</%s>\n" (nth 1 (assq type org-html-divs)))))))))
+
+(defun org-html-inner-template (contents info)
+ "Return body of document string after HTML conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (concat
+ ;; Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth (org-html-toc depth info)))
+ ;; Document contents.
+ contents
+ ;; Footnotes section.
+ (org-html-footnote-section info)))
+
+(defun org-html-template (contents info)
+ "Return complete document string after HTML conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (concat
+ (when (and (not (org-html-html5-p info)) (org-html-xhtml-p info))
+ (let ((decl (or (and (stringp org-html-xml-declaration)
+ org-html-xml-declaration)
+ (cdr (assoc (plist-get info :html-extension)
+ org-html-xml-declaration))
+ (cdr (assoc "html" org-html-xml-declaration))
+
+ "")))
+ (when (not (or (eq nil decl) (string= "" decl)))
+ (format "%s\n"
+ (format decl
+ (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-html-coding-system 'mime-charset))
+ "iso-8859-1"))))))
+ (org-html-doctype info)
+ "\n"
+ (concat "<html"
+ (when (org-html-xhtml-p info)
+ (format
+ " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\""
+ (plist-get info :language) (plist-get info :language)))
+ ">\n")
+ "<head>\n"
+ (org-html--build-meta-info info)
+ (org-html--build-head info)
+ (org-html--build-mathjax-config info)
+ "</head>\n"
+ "<body>\n"
+ (let ((link-up (org-trim (plist-get info :html-link-up)))
+ (link-home (org-trim (plist-get info :html-link-home))))
+ (unless (and (string= link-up "") (string= link-home ""))
+ (format org-html-home/up-format
+ (or link-up link-home)
+ (or link-home link-up))))
+ ;; Preamble.
+ (org-html--build-pre/postamble 'preamble info)
+ ;; Document contents.
+ (format "<%s id=\"%s\">\n"
+ (nth 1 (assq 'content org-html-divs))
+ (nth 2 (assq 'content org-html-divs)))
+ ;; Document title.
+ (let ((title (plist-get info :title)))
+ (format "<h1 class=\"title\">%s</h1>\n" (org-export-data (or title "") info)))
+ contents
+ (format "</%s>\n"
+ (nth 1 (assq 'content org-html-divs)))
+ ;; Postamble.
+ (org-html--build-pre/postamble 'postamble info)
+ ;; Closing document.
+ "</body>\n</html>"))
+
+(defun org-html--translate (s info)
+ "Translate string S according to specified language.
+INFO is a plist used as a communication channel."
+ (org-export-translate s :html info))
+
+;;;; Anchor
+
+(defun org-html--anchor (&optional id desc attributes)
+ "Format a HTML anchor."
+ (let* ((name (and org-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-html--todo (todo)
+ "Format TODO keywords into HTML."
+ (when todo
+ (format "<span class=\"%s %s%s\">%s</span>"
+ (if (member todo org-done-keywords) "done" "todo")
+ org-html-todo-kwd-class-prefix (org-html-fix-class-name todo)
+ todo)))
+
+;;;; Tags
+
+(defun org-html--tags (tags)
+ "Format TAGS into HTML."
+ (when tags
+ (format "<span class=\"tag\">%s</span>"
+ (mapconcat
+ (lambda (tag)
+ (format "<span class=\"%s\">%s</span>"
+ (concat org-html-tag-class-prefix
+ (org-html-fix-class-name tag))
+ tag))
+ tags "&#xa0;"))))
+
+;;;; Headline
+
+(defun* org-html-format-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ "Format a headline in HTML."
+ (let ((section-number
+ (when section-number
+ (format "<span class=\"section-number-%d\">%s</span> "
+ level section-number)))
+ (todo (org-html--todo todo))
+ (tags (org-html--tags tags)))
+ (concat section-number todo (and todo " ") text
+ (and tags "&#xa0;&#xa0;&#xa0;") tags)))
+
+;;;; Src Code
+
+(defun org-html-fontify-code (code lang)
+ "Color CODE with htmlize library.
+CODE is a string representing the source code to colorize. LANG
+is the language used for CODE, as a string, or nil."
+ (when code
+ (cond
+ ;; Case 1: No lang. Possibly an example block.
+ ((not lang)
+ ;; Simple transcoding.
+ (org-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-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-html-encode-plain-text code))
+ ;; Case 2: Default. Fontify code.
+ (t
+ ;; htmlize
+ (setq code (with-temp-buffer
+ ;; Switch to language-specific mode.
+ (funcall lang-mode)
+ (insert code)
+ ;; 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-html-htmlize-region-for-paste
+ (point-min) (point-max))))
+ ;; Strip any enclosing <pre></pre> tags.
+ (let* ((beg (and (string-match "\\`<pre[^>]*>\n*" code) (match-end 0)))
+ (end (and beg (string-match "</pre>\\'" code))))
+ (if (and beg end) (substring code beg end) code)))))))))
+
+(defun org-html-do-format-code
+ (code &optional lang refs retain-labels num-start)
+ "Format CODE string as source code.
+Optional arguments LANG, REFS, RETAIN-LABELS and NUM-START are,
+respectively, the language of the source code, as a string, an
+alist between line numbers and references (as returned by
+`org-export-unravel-code'), a boolean specifying if labels should
+appear in the source code, and the number associated to the first
+line of code."
+ (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-html-fontify-code code lang)))
+ (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-html-format-code (element info)
+ "Format contents of ELEMENT as source code.
+ELEMENT is either an example block or a src block. INFO is
+a plist used as a communication channel."
+ (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-html-do-format-code code lang refs retain-labels num-start)))
+
+
+;;; Tables of Contents
+
+(defun org-html-toc (depth info)
+ "Build a table of contents.
+DEPTH is an integer specifying the depth of the table. INFO is a
+plist used as a communication channel. Return the table of
+contents as a string, or nil if it is empty."
+ (let ((toc-entries
+ (mapcar (lambda (headline)
+ (cons (org-html--format-toc-headline headline info)
+ (org-export-get-relative-level headline info)))
+ (org-export-collect-headlines info depth)))
+ (outer-tag (if (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy))
+ "nav"
+ "div")))
+ (when toc-entries
+ (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
+ (format "<h%d>%s</h%d>\n"
+ org-html-toplevel-hlevel
+ (org-html--translate "Table of Contents" info)
+ org-html-toplevel-hlevel)
+ "<div id=\"text-table-of-contents\">"
+ (org-html--toc-text toc-entries)
+ "</div>\n"
+ (format "</%s>\n" outer-tag)))))
+
+(defun org-html--toc-text (toc-entries)
+ "Return innards of a table of contents, as a string.
+TOC-ENTRIES is an alist where key is an entry title, as a string,
+and value is its relative level, as an integer."
+ (let* ((prev-level (1- (cdar toc-entries)))
+ (start-level prev-level))
+ (concat
+ (mapconcat
+ (lambda (entry)
+ (let ((headline (car entry))
+ (level (cdr entry)))
+ (concat
+ (let* ((cnt (- level prev-level))
+ (times (if (> cnt 0) (1- cnt) (- cnt)))
+ rtn)
+ (setq prev-level level)
+ (concat
+ (org-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-html--make-string (- prev-level start-level) "</li>\n</ul>\n"))))
+
+(defun org-html--format-toc-headline (headline info)
+ "Return an appropriate table of contents entry for HEADLINE.
+INFO is a plist used as a communication channel."
+ (let* ((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-with-backend
+ (org-export-get-alt-title headline info)
+ ;; Create an anonymous back-end that will ignore any
+ ;; footnote-reference, link, radio-target and target
+ ;; in table of contents.
+ (org-export-create-backend
+ :parent 'html
+ :transcoders '((footnote-reference . ignore)
+ (link . (lambda (object c i) c))
+ (radio-target . (lambda (object c i) c))
+ (target . ignore)))
+ info))
+ (tags (and (eq (plist-get info :with-tags) t)
+ (org-export-get-tags headline info))))
+ (format "<a href=\"#%s\">%s</a>"
+ (org-export-solidify-link-text
+ (or (org-element-property :CUSTOM_ID headline)
+ (concat "sec-"
+ (mapconcat
+ #'number-to-string
+ (org-export-get-headline-number headline info)
+ "-"))))
+ (apply (if (functionp org-html-format-headline-function)
+ (lambda (todo todo-type priority text tags &rest ignore)
+ (funcall org-html-format-headline-function
+ todo todo-type priority text tags))
+ #'org-html-format-headline)
+ todo todo-type priority text tags :section-number nil))))
+
+(defun org-html-list-of-listings (info)
+ "Build a list of listings.
+INFO is a plist used as a communication channel. Return the list
+of listings as a string, or nil if it is empty."
+ (let ((lol-entries (org-export-collect-listings info)))
+ (when lol-entries
+ (concat "<div id=\"list-of-listings\">\n"
+ (format "<h%d>%s</h%d>\n"
+ org-html-toplevel-hlevel
+ (org-html--translate "List of Listings" info)
+ org-html-toplevel-hlevel)
+ "<div id=\"text-list-of-listings\">\n<ul>\n"
+ (let ((count 0)
+ (initial-fmt (format "<span class=\"listing-number\">%s</span>"
+ (org-html--translate "Listing %d:" info))))
+ (mapconcat
+ (lambda (entry)
+ (let ((label (org-element-property :name entry))
+ (title (org-trim
+ (org-export-data
+ (or (org-export-get-caption entry t)
+ (org-export-get-caption entry))
+ info))))
+ (concat
+ "<li>"
+ (if (not label)
+ (concat (format initial-fmt (incf count)) " " title)
+ (format "<a href=\"#%s\">%s %s</a>"
+ (org-export-solidify-link-text label)
+ (format initial-fmt (incf count))
+ title))
+ "</li>")))
+ lol-entries "\n"))
+ "\n</ul>\n</div>\n</div>"))))
+
+(defun org-html-list-of-tables (info)
+ "Build a list of tables.
+INFO is a plist used as a communication channel. Return the list
+of tables as a string, or nil if it is empty."
+ (let ((lol-entries (org-export-collect-tables info)))
+ (when lol-entries
+ (concat "<div id=\"list-of-tables\">\n"
+ (format "<h%d>%s</h%d>\n"
+ org-html-toplevel-hlevel
+ (org-html--translate "List of Tables" info)
+ org-html-toplevel-hlevel)
+ "<div id=\"text-list-of-tables\">\n<ul>\n"
+ (let ((count 0)
+ (initial-fmt (format "<span class=\"table-number\">%s</span>"
+ (org-html--translate "Table %d:" info))))
+ (mapconcat
+ (lambda (entry)
+ (let ((label (org-element-property :name entry))
+ (title (org-trim
+ (org-export-data
+ (or (org-export-get-caption entry t)
+ (org-export-get-caption entry))
+ info))))
+ (concat
+ "<li>"
+ (if (not label)
+ (concat (format initial-fmt (incf count)) " " title)
+ (format "<a href=\"#%s\">%s %s</a>"
+ (org-export-solidify-link-text label)
+ (format initial-fmt (incf count))
+ title))
+ "</li>")))
+ lol-entries "\n"))
+ "\n</ul>\n</div>\n</div>"))))
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-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-html-text-markup-alist)) "%s")
+ contents))
+
+;;;; Center Block
+
+(defun org-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."
+ (format "<div class=\"center\">\n%s</div>" contents))
+
+;;;; Clock
+
+(defun org-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 :raw-value
+ (org-element-property :value clock)))
+ (let ((time (org-element-property :duration clock)))
+ (and time (format " <span class=\"timestamp\">(%s)</span>" time)))))
+
+;;;; Code
+
+(defun org-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-html-text-markup-alist)) "%s")
+ (org-html-encode-plain-text (org-element-property :value code))))
+
+;;;; Drawer
+
+(defun org-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."
+ (if (functionp org-html-format-drawer-function)
+ (funcall org-html-format-drawer-function
+ (org-element-property :drawer-name drawer)
+ contents)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents))
+
+;;;; Dynamic Block
+
+(defun org-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'."
+ contents)
+
+;;;; Entity
+
+(defun org-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-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."
+ (if (org-export-read-attribute :attr_html example-block :textarea)
+ (org-html--textarea-block example-block)
+ (format "<pre class=\"example\">\n%s</pre>"
+ (org-html-format-code example-block info))))
+
+;;;; Export Snippet
+
+(defun org-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) 'html)
+ (org-element-property :value export-snippet)))
+
+;;;; Export Block
+
+(defun org-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-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."
+ (format "<pre class=\"example\">\n%s</pre>"
+ (org-html-do-format-code
+ (org-remove-indentation
+ (org-element-property :value fixed-width)))))
+
+;;;; Footnote Reference
+
+(defun org-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-html-footnote-separator))
+ (cond
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (org-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-html-format-footnote-reference
+ (org-export-get-footnote-number footnote-reference info)
+ "IGNORED" 1))
+ ;; Non-inline footnotes definitions are full Org data.
+ (t (org-html-format-footnote-reference
+ (org-export-get-footnote-number footnote-reference info)
+ "IGNORED" 1)))))
+
+;;;; Headline
+
+(defun org-html-format-headline--wrap
+ (headline info &optional format-function &rest extra-keys)
+ "Transcode a 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-html-toplevel-hlevel)))
+ (headline-number (org-export-get-headline-number headline info))
+ (section-number (and (not (org-export-low-level-p headline info))
+ (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-html-format-headline-function)
+ (lambda (todo todo-type priority text tags &rest ignore)
+ (funcall org-html-format-headline-function
+ todo todo-type priority text tags)))
+ (t 'org-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-html-headline (headline contents info)
+ "Transcode a 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-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)
+ ;; Build the real contents of the sub-tree.
+ (let* ((type (if numberedp 'ordered 'unordered))
+ (itemized-body (org-html-format-list-item
+ contents type nil info nil full-text)))
+ (concat
+ (and (org-export-first-sibling-p headline info)
+ (org-html-begin-plain-list type))
+ itemized-body
+ (and (org-export-last-sibling-p headline info)
+ (org-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-html-toplevel-hlevel)))
+ (first-content (car (org-element-contents headline))))
+ (format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n"
+ (org-html--container headline info)
+ (format "outline-container-%s"
+ (or (org-element-property :CUSTOM_ID headline)
+ (concat "sec-" 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-html--anchor id)))
+ extra-ids "")
+ full-text
+ level1)
+ ;; When there is no section, pretend there is an empty
+ ;; one to get the correct <div class="outline- ...>
+ ;; which is needed by `org-info.js'.
+ (if (not (eq (org-element-type first-content) 'section))
+ (concat (org-html-section first-content "" info)
+ contents)
+ contents)
+ (org-html--container headline info)))))))
+
+(defun org-html--container (headline info)
+ (or (org-element-property :HTML_CONTAINER headline)
+ (if (= 1 (org-export-get-relative-level headline info))
+ (plist-get info :html-container)
+ "div")))
+
+;;;; Horizontal Rule
+
+(defun org-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."
+ (org-html-close-tag "hr" nil info))
+
+;;;; Inline Src Block
+
+(defun org-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)))
+ (error "Cannot export inline src block")))
+
+;;;; Inlinetask
+
+(defun org-html-format-section (text class &optional id)
+ "Format a section with TEXT into a HTML div with CLASS and ID."
+ (let ((extra (concat (when id (format " id=\"%s\"" id)))))
+ (concat (format "<div class=\"%s\"%s>\n" class extra) text "</div>\n")))
+
+(defun org-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-html-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ ((functionp org-html-format-inlinetask-function)
+ (let ((format-function
+ (function*
+ (lambda (todo todo-type priority text tags
+ &key contents &allow-other-keys)
+ (funcall org-html-format-inlinetask-function
+ todo todo-type priority text tags contents)))))
+ (org-html-format-headline--wrap
+ inlinetask info format-function :contents contents)))
+ ;; Otherwise, use a default template.
+ (t (format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>"
+ (org-html-format-headline--wrap inlinetask info)
+ (org-html-close-tag "br" nil info)
+ contents))))
+
+;;;; Italic
+
+(defun org-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-html-text-markup-alist)) "%s") contents))
+
+;;;; Item
+
+(defun org-html-checkbox (checkbox)
+ "Format CHECKBOX into HTML."
+ (case checkbox (on "<code>[X]</code>")
+ (off "<code>[&#xa0;]</code>")
+ (trans "<code>[-]</code>")
+ (t "")))
+
+(defun org-html-format-list-item (contents type checkbox info
+ &optional term-counter-id
+ headline)
+ "Format a list item into HTML."
+ (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " ")))
+ (br (org-html-close-tag "br" nil info)))
+ (concat
+ (case type
+ (ordered
+ (let* ((counter term-counter-id)
+ (extra (if counter (format " value=\"%s\"" counter) "")))
+ (concat
+ (format "<li%s>" extra)
+ (when headline (concat headline br)))))
+ (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-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-html-format-list-item
+ contents type checkbox info (or tag counter))))
+
+;;;; Keyword
+
+(defun org-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 "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-html-toc depth info)))
+ ((string= "listings" value) (org-html-list-of-listings info))
+ ((string= "tables" value) (org-html-list-of-tables info))))))))
+
+;;;; Latex Environment
+
+(defun org-html-format-latex (latex-frag processing-type)
+ "Format a LaTeX fragment LATEX-FRAG into HTML."
+ (let ((cache-relpath "") (cache-dir ""))
+ (unless (eq processing-type 'mathjax)
+ (let ((bfn (or (buffer-file-name)
+ (make-temp-name
+ (expand-file-name "latex" temporary-file-directory)))))
+ (setq cache-relpath
+ (concat "ltxpng/"
+ (file-name-sans-extension
+ (file-name-nondirectory bfn)))
+ cache-dir (file-name-directory bfn))))
+ (with-temp-buffer
+ (insert latex-frag)
+ (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..."
+ nil nil processing-type)
+ (buffer-string))))
+
+(defun org-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."
+ (let ((processing-type (plist-get info :with-latex))
+ (latex-frag (org-remove-indentation
+ (org-element-property :value latex-environment)))
+ (attributes (org-export-read-attribute :attr_html latex-environment)))
+ (case processing-type
+ ((t mathjax)
+ (org-html-format-latex latex-frag 'mathjax))
+ ((dvipng imagemagick)
+ (let ((formula-link (org-html-format-latex latex-frag processing-type)))
+ (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+ ;; Do not provide a caption or a name to be consistent with
+ ;; `mathjax' handling.
+ (org-html--wrap-image
+ (org-html--format-image
+ (match-string 1 formula-link) attributes info) info))))
+ (t latex-frag))))
+
+;;;; Latex Fragment
+
+(defun org-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 :with-latex)))
+ (case processing-type
+ ((t mathjax)
+ (org-html-format-latex latex-frag 'mathjax))
+ ((dvipng imagemagick)
+ (let ((formula-link (org-html-format-latex latex-frag processing-type)))
+ (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+ (org-html--format-image (match-string 1 formula-link) nil info))))
+ (t latex-frag))))
+
+;;;; Line Break
+
+(defun org-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."
+ (concat (org-html-close-tag "br" nil info) "\n"))
+
+;;;; Link
+
+(defun org-html-inline-image-p (link info)
+ "Non-nil when LINK is meant to appear as an image.
+INFO is a plist used as a communication channel. LINK is an
+inline image when it has no description and targets an image
+file (see `org-html-inline-image-rules' for more information), or
+if its description is a single link targeting an image file."
+ (if (not (org-element-contents link))
+ (org-export-inline-image-p link org-html-inline-image-rules)
+ (not
+ (let ((link-count 0))
+ (org-element-map (org-element-contents link)
+ (cons 'plain-text org-element-all-objects)
+ (lambda (obj)
+ (case (org-element-type obj)
+ (plain-text (org-string-nw-p obj))
+ (link (if (= link-count 1) t
+ (incf link-count)
+ (not (org-export-inline-image-p
+ obj org-html-inline-image-rules))))
+ (otherwise t)))
+ info t)))))
+
+(defvar org-html-standalone-image-predicate)
+(defun org-html-standalone-image-p (element info)
+ "Test if ELEMENT is a standalone image.
+
+INFO is a plist holding contextual information.
+
+Return non-nil, if ELEMENT is of type paragraph and its sole
+content, save for white spaces, is a link that qualifies as an
+inline image.
+
+Return non-nil, if ELEMENT is of type link and its containing
+paragraph has no other content save white spaces.
+
+Return nil, otherwise.
+
+Bind `org-html-standalone-image-predicate' to constrain paragraph
+further. For example, to check for only captioned standalone
+images, set it to:
+
+ \(lambda (paragraph) (org-element-property :caption paragraph))"
+ (let ((paragraph (case (org-element-type element)
+ (paragraph element)
+ (link (org-export-get-parent element)))))
+ (and (eq (org-element-type paragraph) 'paragraph)
+ (or (not (and (boundp 'org-html-standalone-image-predicate)
+ (functionp org-html-standalone-image-predicate)))
+ (funcall org-html-standalone-image-predicate paragraph))
+ (not (let ((link-count 0))
+ (org-element-map (org-element-contents paragraph)
+ (cons 'plain-text org-element-all-objects)
+ (lambda (obj) (case (org-element-type obj)
+ (plain-text (org-string-nw-p obj))
+ (link
+ (or (> (incf link-count) 1)
+ (not (org-html-inline-image-p obj info))))
+ (otherwise t)))
+ info 'first-match 'link))))))
+
+(defun org-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* ((home (when (plist-get info :html-link-home)
+ (org-trim (plist-get info :html-link-home))))
+ (use-abs-url (plist-get info :html-link-use-abs-url))
+ (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-html-link-org-files-as-html'."
+ (cond
+ ((and org-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 (org-string-nw-p desc))
+ (path
+ (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ ;; 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://".
+ (cond ((file-name-absolute-p raw-path)
+ (setq raw-path
+ (concat "file://" (expand-file-name
+ raw-path))))
+ ((and home use-abs-url)
+ (setq raw-path (concat (file-name-as-directory home) raw-path))))
+ ;; Add search option, if any. A search option can be
+ ;; relative to a custom-id or a headline title. Any other
+ ;; option is ignored.
+ (let ((option (org-element-property :search-option link)))
+ (cond ((not option) raw-path)
+ ((eq (aref option 0) ?#) (concat raw-path option))
+ ;; External fuzzy link: try to resolve it if path
+ ;; belongs to current project, if any.
+ ((eq (aref option 0) ?*)
+ (concat
+ raw-path
+ (let ((numbers
+ (org-publish-resolve-external-fuzzy-link
+ (org-element-property :path link) option)))
+ (and numbers (concat "#sec-"
+ (mapconcat 'number-to-string
+ numbers "-"))))))
+ (t raw-path))))
+ (t raw-path)))
+ ;; Extract attributes from parent's paragraph. HACK: Only do
+ ;; this for the first link in parent (inner image link for
+ ;; inline images). This is needed as long as attributes
+ ;; cannot be set on a per link basis.
+ (attributes-plist
+ (let* ((parent (org-export-get-parent-element link))
+ (link (let ((container (org-export-get-parent link)))
+ (if (and (eq (org-element-type container) 'link)
+ (org-html-inline-image-p link info))
+ container
+ link))))
+ (and (eq (org-element-map parent 'link 'identity info t) link)
+ (org-export-read-attribute :attr_html parent))))
+ (attributes
+ (let ((attr (org-html--make-attribute-string attributes-plist)))
+ (if (org-string-nw-p attr) (concat " " attr) "")))
+ protocol)
+ (cond
+ ;; Image file.
+ ((and org-html-inline-images
+ (org-export-inline-image-p link org-html-inline-image-rules))
+ (org-html--format-image path attributes-plist 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 a 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
+ (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))))
+ ;; Link points to a 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. Display section number.
+ (if (and (org-export-numbered-headline-p destination info)
+ (not desc))
+ (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 or an element.
+ (t
+ (let* ((path (org-export-solidify-link-text path))
+ (org-html-standalone-image-predicate 'org-html--has-caption-p)
+ (number (cond
+ (desc nil)
+ ((org-html-standalone-image-p destination info)
+ (org-export-get-ordinal
+ (org-element-map destination 'link
+ 'identity info t)
+ info 'link 'org-html-standalone-image-p))
+ (t (org-export-get-ordinal
+ destination info nil 'org-html--has-caption-p))))
+ (desc (cond (desc)
+ ((not number) "No description for this link")
+ ((numberp number) (number-to-string number))
+ (t (mapconcat 'number-to-string number ".")))))
+ (format "<a href=\"#%s\"%s>%s</a>" path attributes desc))))))
+ ;; 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
+ (org-trim
+ (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)))))
+
+;;;; Paragraph
+
+(defun org-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* ((parent (org-export-get-parent paragraph))
+ (parent-type (org-element-type parent))
+ (style '((footnote-definition " class=\"footpara\"")))
+ (extra (or (cadr (assoc parent-type style)) "")))
+ (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-html-standalone-image-p paragraph info)
+ ;; Standalone image.
+ (let ((caption
+ (let ((raw (org-export-data
+ (org-export-get-caption paragraph) info))
+ (org-html-standalone-image-predicate
+ 'org-html--has-caption-p))
+ (if (not (org-string-nw-p raw)) raw
+ (concat
+ "<span class=\"figure-number\">"
+ (format (org-html--translate "Figure %d:" info)
+ (org-export-get-ordinal
+ (org-element-map paragraph 'link
+ 'identity info t)
+ info nil 'org-html-standalone-image-p))
+ "</span> " raw))))
+ (label (org-element-property :name paragraph)))
+ (org-html--wrap-image contents info caption label)))
+ ;; Regular paragraph.
+ (t (format "<p%s>\n%s</p>" extra contents)))))
+
+;;;; Plain List
+
+;; FIXME Maybe arg1 is not needed because <li value="20"> already sets
+;; the correct value for the item counter
+(defun org-html-begin-plain-list (type &optional arg1)
+ "Insert the beginning of the HTML list depending on TYPE.
+When ARG1 is a string, use it as the start parameter for ordered
+lists."
+ (case type
+ (ordered
+ (format "<ol class=\"org-ol\"%s>"
+ (if arg1 (format " start=\"%d\"" arg1) "")))
+ (unordered "<ul class=\"org-ul\">")
+ (descriptive "<dl class=\"org-dl\">")))
+
+(defun org-html-end-plain-list (type)
+ "Insert the end of the HTML list depending on TYPE."
+ (case type
+ (ordered "</ol>")
+ (unordered "</ul>")
+ (descriptive "</dl>")))
+
+(defun org-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 ;; (assoc :counter (org-element-map plain-list 'item
+ (type (org-element-property :type plain-list)))
+ (format "%s\n%s%s"
+ (org-html-begin-plain-list type)
+ contents (org-html-end-plain-list type))))
+
+;;;; Plain Text
+
+(defun org-html-convert-special-strings (string)
+ "Convert special characters in STRING to HTML."
+ (let ((all org-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-html-encode-plain-text (text)
+ "Convert plain text characters from TEXT to HTML equivalent.
+Possible conversions are set in `org-html-protect-char-alist'."
+ (mapc
+ (lambda (pair)
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
+ org-html-protect-char-alist)
+ text)
+
+(defun org-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."
+ (let ((output text))
+ ;; Protect following characters: <, >, &.
+ (setq output (org-html-encode-plain-text output))
+ ;; Handle smart quotes. Be sure to provide original string since
+ ;; OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output (org-export-activate-smart-quotes output :html info text)))
+ ;; Handle special strings.
+ (when (plist-get info :with-special-strings)
+ (setq output (org-html-convert-special-strings output)))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output
+ (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n"
+ (concat (org-html-close-tag "br" nil info) "\n") output)))
+ ;; Return value.
+ output))
+
+
+;; Planning
+
+(defun org-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
+ (org-element-property :raw-value closed)))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (format span-fmt org-deadline-string
+ (org-translate-time
+ (org-element-property :raw-value deadline)))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (format span-fmt org-scheduled-string
+ (org-translate-time
+ (org-element-property :raw-value scheduled)))))))
+ " "))))
+
+;;;; Property Drawer
+
+(defun org-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-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."
+ (format "<blockquote>\n%s</blockquote>" contents))
+
+;;;; Quote Section
+
+(defun org-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-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-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-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-html--anchor id text)))
+
+;;;; Special Block
+
+(defun org-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* ((block-type (downcase
+ (org-element-property :type special-block)))
+ (contents (or contents ""))
+ (html5-fancy (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy)
+ (member block-type org-html-html5-elements)))
+ (attributes (org-export-read-attribute :attr_html special-block)))
+ (unless html5-fancy
+ (let ((class (plist-get attributes :class)))
+ (setq attributes (plist-put attributes :class
+ (if class (concat class " " block-type)
+ block-type)))))
+ (setq attributes (org-html--make-attribute-string attributes))
+ (when (not (equal attributes ""))
+ (setq attributes (concat " " attributes)))
+ (if html5-fancy
+ (format "<%s%s>\n%s</%s>" block-type attributes
+ contents block-type)
+ (format "<div%s>\n%s\n</div>" attributes contents))))
+
+;;;; Src Block
+
+(defun org-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."
+ (if (org-export-read-attribute :attr_html src-block :textarea)
+ (org-html--textarea-block src-block)
+ (let ((lang (org-element-property :language src-block))
+ (caption (org-export-get-caption src-block))
+ (code (org-html-format-code src-block info))
+ (label (let ((lbl (org-element-property :name src-block)))
+ (if (not lbl) ""
+ (format " id=\"%s\""
+ (org-export-solidify-link-text lbl))))))
+ (if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code)
+ (format
+ "<div class=\"org-src-container\">\n%s%s\n</div>"
+ (if (not caption) ""
+ (format "<label class=\"org-src-name\">%s</label>"
+ (org-export-data caption info)))
+ (format "\n<pre class=\"src src-%s\"%s>%s</pre>" lang label code))))))
+
+;;;; Statistics Cookie
+
+(defun org-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-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-html-text-markup-alist)) "%s")
+ contents))
+
+;;;; Subscript
+
+(defun org-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-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-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-html-table-align-individual-fields) ""
+ (format (if (and (boundp 'org-html-format-table-no-css)
+ org-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 "&#xa0;"))
+ (cond
+ ((and (org-export-table-has-header-p table info)
+ (= 1 (org-export-table-row-group table-row info)))
+ (concat "\n" (format (car org-html-table-header-tags) "col" cell-attrs)
+ contents (cdr org-html-table-header-tags)))
+ ((and org-html-table-use-header-tags-for-first-column
+ (zerop (cdr (org-export-table-cell-address table-cell info))))
+ (concat "\n" (format (car org-html-table-header-tags) "row" cell-attrs)
+ contents (cdr org-html-table-header-tags)))
+ (t (concat "\n" (format (car org-html-table-data-tags) cell-attrs)
+ contents (cdr org-html-table-data-tags))))))
+
+;;;; Table Row
+
+(defun org-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* ((rowgroup-number (org-export-table-row-group table-row info))
+ (row-number (org-export-table-row-number table-row info))
+ (start-rowgroup-p
+ (org-export-table-row-starts-rowgroup-p table-row info))
+ (end-rowgroup-p
+ (org-export-table-row-ends-rowgroup-p table-row info))
+ ;; `top-row-p' and `end-rowgroup-p' are not used directly
+ ;; but should be set so that `org-html-table-row-tags' can
+ ;; use them (see the docstring of this variable.)
+ (top-row-p (and (equal start-rowgroup-p '(top))
+ (equal end-rowgroup-p '(below top))))
+ (bottom-row-p (and (equal start-rowgroup-p '(above))
+ (equal end-rowgroup-p '(bottom above))))
+ (rowgroup-tags
+ (cond
+ ;; Case 1: Row belongs to second or subsequent rowgroups.
+ ((not (= 1 rowgroup-number))
+ '("<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 start-rowgroup-p (car rowgroup-tags))
+ ;; Actual table row
+ (concat "\n" (eval (car org-html-table-row-tags))
+ contents
+ "\n"
+ (eval (cdr org-html-table-row-tags)))
+ ;; End a rowgroup?
+ (when end-rowgroup-p (cdr rowgroup-tags))))))
+
+;;;; Table
+
+(defun org-html-table-first-row-data-cells (table info)
+ "Transcode the first row of TABLE.
+INFO is a plist used as a communication channel."
+ (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-html-table--table.el-table (table info)
+ "Format table.el tables into HTML.
+INFO is a plist used as a communication channel."
+ (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-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-html-table--table.el-table table info))
+ ;; Case 2: Standard table.
+ (t
+ (let* ((label (org-element-property :name table))
+ (caption (org-export-get-caption table))
+ (number (org-export-get-ordinal
+ table info nil 'org-html--has-caption-p))
+ (attributes
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (and label (list :id (org-export-solidify-link-text label)))
+ (and (not (org-html-html5-p info))
+ (plist-get info :html-table-attributes))
+ (org-export-read-attribute :attr_html table))))
+ (alignspec
+ (if (and (boundp 'org-html-format-table-no-css)
+ org-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%s"
+ (org-html-close-tag
+ "col" (concat " " (format alignspec alignment)) info))
+ ;; End a colgroup?
+ (when (org-export-table-cell-ends-colgroup-p
+ table-cell info)
+ "\n</colgroup>"))))
+ (org-html-table-first-row-data-cells table info) "\n")))))
+ (format "<table%s>\n%s\n%s\n%s</table>"
+ (if (equal attributes "") "" (concat " " attributes))
+ (if (not caption) ""
+ (format (if org-html-table-caption-above
+ "<caption align=\"above\">%s</caption>"
+ "<caption align=\"bottom\">%s</caption>")
+ (concat
+ "<span class=\"table-number\">"
+ (format (org-html--translate "Table %d:" info) number)
+ "</span> " (org-export-data caption info))))
+ (funcall table-column-specs table info)
+ contents)))))
+
+;;;; Target
+
+(defun org-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-html--anchor id)))
+
+;;;; Timestamp
+
+(defun org-html-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((value (org-html-plain-text
+ (org-timestamp-translate timestamp) info)))
+ (format "<span class=\"timestamp-wrapper\"><span class=\"timestamp\">%s</span></span>"
+ (replace-regexp-in-string "--" "&#x2013;" value))))
+
+;;;; Underline
+
+(defun org-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-html-text-markup-alist)) "%s")
+ contents))
+
+;;;; Verbatim
+
+(defun org-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-html-text-markup-alist)) "%s")
+ (org-html-encode-plain-text (org-element-property :value verbatim))))
+
+;;;; Verse Block
+
+(defun org-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
+ "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info))
+ (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n"
+ (format "%s\n" (org-html-close-tag "br" nil info)) 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 "&#xa0;"))))))
+ (setq contents (replace-match ws nil t contents))))
+ (format "<p class=\"verse\">\n%s</p>" contents))
+
+
+;;; Filter Functions
+
+(defun org-html-final-function (contents backend info)
+ "Filter to indent the HTML and convert HTML entities."
+ (with-temp-buffer
+ (insert contents)
+ (set-auto-mode t)
+ (if org-html-indent
+ (indent-region (point-min) (point-max)))
+ (when org-html-use-unicode-chars
+ (require 'mm-url)
+ (mm-url-decode-entities))
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+
+;;; End-user functions
+
+;;;###autoload
+(defun org-html-export-as-html
+ (&optional async 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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+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 HTML Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (org-export-to-buffer 'html "*Org HTML Export*"
+ async subtreep visible-only body-only ext-plist
+ (lambda () (set-auto-mode t))))
+
+;;;###autoload
+(defun org-html-convert-region-to-html ()
+ "Assume the current region has org-mode syntax, and convert it to HTML.
+This can be used in any buffer. For example, you can write an
+itemized list in org-mode syntax in an HTML buffer and use this
+command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'html))
+
+;;;###autoload
+(defun org-html-export-to-html
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return output file's name."
+ (interactive)
+ (let* ((extension (concat "." org-html-extension))
+ (file (org-export-output-file-name extension subtreep))
+ (org-export-coding-system org-html-coding-system))
+ (org-export-to-file 'html file
+ async subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-html-publish-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-publish-org-to 'html filename
+ (concat "." (or (plist-get plist :html-extension)
+ org-html-extension "html"))
+ plist pub-dir))
+
+
+;;; FIXME
+
+;;;; org-format-table-html
+;;;; org-format-org-table-html
+;;;; org-format-table-table-html
+;;;; org-table-number-fraction
+;;;; org-table-number-regexp
+;;;; org-html-inline-image-extensions
+;;;; org-export-preferred-target-alist
+;;;; class for anchors
+;;;; org-export-mark-todo-in-toc
+;;;; org-html-format-org-link
+;;;; (caption (and caption (org-xml-encode-org-text caption)))
+;;;; alt = (file-name-nondirectory path)
+
+(provide 'ox-html)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-html.el ends here
diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el
new file mode 100644
index 0000000000..8dfe836c9f
--- /dev/null
+++ b/lisp/org/ox-icalendar.el
@@ -0,0 +1,979 @@
+;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Nicolas Goaziou <n dot goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+
+;; 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 an iCalendar back-end for Org generic
+;; exporter. See Org manual for more information.
+;;
+;; It is expected to conform to RFC 5545.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox-ascii)
+(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-icalendar nil
+ "Options specific for iCalendar export back-end."
+ :tag "Org Export iCalendar"
+ :group 'org-export)
+
+(defcustom org-icalendar-combined-agenda-file "~/org.ics"
+ "The file name for the iCalendar file covering all agenda files.
+This file is created with the command \\[org-icalendar-combine-agenda-files].
+The file name should be absolute. It 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 ""
+ "Calendar description for the combined iCalendar (all agenda files)."
+ :group 'org-export-icalendar
+ :type 'string)
+
+(defcustom org-icalendar-exclude-tags nil
+ "Tags that exclude a tree from export.
+This variable allows to specify different exclude tags from other
+back-ends. It can also be set with the ICAL_EXCLUDE_TAGS
+keyword."
+ :group 'org-export-icalendar
+ :type '(repeat (string :tag "Tag")))
+
+(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-with-timestamps 'active
+ "Non-nil means make an event from plain time stamps.
+
+It can be set to `active', `inactive', t or nil, in order to make
+an event from, respectively, only active timestamps, only
+inactive ones, all of them or none.
+
+This variable has precedence over `org-export-with-timestamps'.
+It can also be set with the #+OPTIONS line, e.g. \"<:t\"."
+ :group 'org-export-icalendar
+ :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-icalendar-include-todo nil
+ "Non-nil means create VTODO components from TODO items.
+
+Valid values are:
+nil don't include any task.
+t include tasks that are not in 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)
+ (repeat :tag "Specific TODO keywords"
+ (string :tag "Keyword"))))
+
+(defcustom org-icalendar-include-bbdb-anniversaries nil
+ "Non-nil means a combined iCalendar file should include anniversaries.
+The anniversaries are defined 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 t
+ "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")))
+
+(defcustom org-icalendar-date-time-format ":%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")))
+
+(defvar org-icalendar-after-save-hook nil
+ "Hook run after an iCalendar file has been saved.
+This hook is run with the name of the file as argument. A good
+way to use this is to tell a desktop calendar application to
+re-read the iCalendar file.")
+
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend 'icalendar 'ascii
+ :translate-alist '((clock . ignore)
+ (footnote-definition . ignore)
+ (footnote-reference . ignore)
+ (headline . org-icalendar-entry)
+ (inlinetask . ignore)
+ (planning . ignore)
+ (section . ignore)
+ (inner-template . (lambda (c i) c))
+ (template . org-icalendar-template))
+ :options-alist
+ '((:exclude-tags
+ "ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split)
+ (:with-timestamps nil "<" org-icalendar-with-timestamps)
+ (:with-vtodo nil nil org-icalendar-include-todo)
+ ;; The following property will be non-nil when export has been
+ ;; started from org-agenda-mode. In this case, any entry without
+ ;; a non-nil "ICALENDAR_MARK" property will be ignored.
+ (:icalendar-agenda-view nil nil nil))
+ :filters-alist
+ '((:filter-headline . org-icalendar-clear-blank-lines))
+ :menu-entry
+ '(?c "Export to iCalendar"
+ ((?f "Current file" org-icalendar-export-to-ics)
+ (?a "All agenda files"
+ (lambda (a s v b) (org-icalendar-export-agenda-files a)))
+ (?c "Combine all agenda files"
+ (lambda (a s v b) (org-icalendar-combine-agenda-files a))))))
+
+
+
+;;; Internal Functions
+
+(defun org-icalendar-create-uid (file &optional bell h-markers)
+ "Set ID property on headlines missing it in FILE.
+When optional argument BELL is non-nil, inform the user with
+a message if the file was modified. With optional argument
+H-MARKERS non-nil, it is a list of markers for the headlines
+which will be updated."
+ (let ((pt (if h-markers (goto-char (car h-markers)) (point-min)))
+ modified-flag)
+ (org-map-entries
+ (lambda ()
+ (let ((entry (org-element-at-point)))
+ (unless (or (< (point) pt) (org-element-property :ID entry))
+ (org-id-get-create)
+ (setq modified-flag t)
+ (forward-line))
+ (when h-markers (setq org-map-continue-from (pop h-markers)))))
+ nil nil 'comment)
+ (when (and bell modified-flag)
+ (message "ID properties created in file \"%s\"" file)
+ (sit-for 2))))
+
+(defun org-icalendar-blocked-headline-p (headline info)
+ "Non-nil when HEADLINE is considered to be blocked.
+
+INFO is a plist used as a communication channel.
+
+a headline is blocked when either:
+
+ - It has children which are not all in a completed state.
+
+ - It has a parent with the property :ORDERED:, and there are
+ siblings prior to it with incomplete status.
+
+ - Its parent is blocked because it has siblings that should be
+ done first or is a child of a blocked grandparent entry."
+ (or
+ ;; Check if any child is not done.
+ (org-element-map headline 'headline
+ (lambda (hl) (eq (org-element-property :todo-type hl) 'todo))
+ info 'first-match)
+ ;; Check :ORDERED: node property.
+ (catch 'blockedp
+ (let ((current headline))
+ (mapc (lambda (parent)
+ (cond
+ ((not (org-element-property :todo-keyword parent))
+ (throw 'blockedp nil))
+ ((org-not-nil (org-element-property :ORDERED parent))
+ (let ((sibling current))
+ (while (setq sibling (org-export-get-previous-element
+ sibling info))
+ (when (eq (org-element-property :todo-type sibling) 'todo)
+ (throw 'blockedp t)))))
+ (t (setq current parent))))
+ (org-export-get-genealogy headline))
+ nil))))
+
+(defun org-icalendar-use-UTC-date-time-p ()
+ "Non-nil when `org-icalendar-date-time-format' requires UTC time."
+ (char-equal (elt org-icalendar-date-time-format
+ (1- (length org-icalendar-date-time-format))) ?Z))
+
+(defvar org-agenda-default-appointment-duration) ; From org-agenda.el.
+(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc)
+ "Convert TIMESTAMP to iCalendar format.
+
+TIMESTAMP is a timestamp object. KEYWORD is added in front of
+it, in order to make a complete line (e.g. \"DTSTART\").
+
+When optional argument END is non-nil, use end of time range.
+Also increase the hour by two (if time string contains a time),
+or the day by one (if it does not contain a time) when no
+explicit ending time is specified.
+
+When optional argument UTC is non-nil, time will be expressed in
+Universal Time, ignoring `org-icalendar-date-time-format'."
+ (let* ((year-start (org-element-property :year-start timestamp))
+ (year-end (org-element-property :year-end timestamp))
+ (month-start (org-element-property :month-start timestamp))
+ (month-end (org-element-property :month-end timestamp))
+ (day-start (org-element-property :day-start timestamp))
+ (day-end (org-element-property :day-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp))
+ (minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (with-time-p minute-start)
+ (equal-bounds-p
+ (equal (list year-start month-start day-start hour-start minute-start)
+ (list year-end month-end day-end hour-end minute-end)))
+ (mi (cond ((not with-time-p) 0)
+ ((not end) minute-start)
+ ((and org-agenda-default-appointment-duration equal-bounds-p)
+ (+ minute-end org-agenda-default-appointment-duration))
+ (t minute-end)))
+ (h (cond ((not with-time-p) 0)
+ ((not end) hour-start)
+ ((or (not equal-bounds-p)
+ org-agenda-default-appointment-duration)
+ hour-end)
+ (t (+ hour-end 2))))
+ (d (cond ((not end) day-start)
+ ((not with-time-p) (1+ day-end))
+ (t day-end)))
+ (m (if end month-end month-start))
+ (y (if end year-end year-start)))
+ (concat
+ keyword
+ (format-time-string
+ (cond (utc ":%Y%m%dT%H%M%SZ")
+ ((not with-time-p) ";VALUE=DATE:%Y%m%d")
+ (t (replace-regexp-in-string "%Z"
+ org-icalendar-timezone
+ org-icalendar-date-time-format
+ t)))
+ ;; Convert timestamp into internal time in order to use
+ ;; `format-time-string' and fix any mistake (i.e. MI >= 60).
+ (encode-time 0 mi h d m y)
+ (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p)))))))
+
+(defun org-icalendar-dtstamp ()
+ "Return DTSTAMP property, as a string."
+ (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t))
+
+(defun org-icalendar-get-categories (entry info)
+ "Return categories according to `org-icalendar-categories'.
+ENTRY is a headline or an inlinetask element. INFO is a plist
+used as a communication channel."
+ (mapconcat
+ 'identity
+ (org-uniquify
+ (let (categories)
+ (mapc (lambda (type)
+ (case type
+ (category
+ (push (org-export-get-category entry info) categories))
+ (todo-state
+ (let ((todo (org-element-property :todo-keyword entry)))
+ (and todo (push todo categories))))
+ (local-tags
+ (setq categories
+ (append (nreverse (org-export-get-tags entry info))
+ categories)))
+ (all-tags
+ (setq categories
+ (append (nreverse (org-export-get-tags entry info nil t))
+ categories)))))
+ org-icalendar-categories)
+ ;; Return list of categories, following specified order.
+ (nreverse categories))) ","))
+
+(defun org-icalendar-transcode-diary-sexp (sexp uid summary)
+ "Transcode a diary sexp into iCalendar format.
+SEXP is the diary sexp being transcoded, as a string. UID is the
+unique identifier for the entry. SUMMARY defines a short summary
+or subject for the event."
+ (when (require 'icalendar nil t)
+ (org-element-normalize-string
+ (with-temp-buffer
+ (let ((sexp (if (not (string-match "\\`<%%" sexp)) sexp
+ (concat (substring sexp 1 -1) " " summary))))
+ (put-text-property 0 1 'uid uid sexp)
+ (insert sexp "\n"))
+ (org-diary-to-ical-string (current-buffer))))))
+
+(defun org-icalendar-cleanup-string (s)
+ "Cleanup string S according to RFC 5545."
+ (when s
+ ;; Protect "\", "," and ";" characters. and replace newline
+ ;; characters with literal \n.
+ (replace-regexp-in-string
+ "[ \t]*\n" "\\n"
+ (replace-regexp-in-string "[\\,;]" "\\\&" s)
+ nil t)))
+
+(defun org-icalendar-fold-string (s)
+ "Fold string S according to RFC 5545."
+ (org-element-normalize-string
+ (mapconcat
+ (lambda (line)
+ ;; Limit each line to a maximum of 75 characters. If it is
+ ;; longer, fold it by using "\n " as a continuation marker.
+ (let ((len (length line)))
+ (if (<= len 75) line
+ (let ((folded-line (substring line 0 75))
+ (chunk-start 75)
+ chunk-end)
+ ;; Since continuation marker takes up one character on the
+ ;; line, real contents must be split at 74 chars.
+ (while (< (setq chunk-end (+ chunk-start 74)) len)
+ (setq folded-line
+ (concat folded-line "\n "
+ (substring line chunk-start chunk-end))
+ chunk-start chunk-end))
+ (concat folded-line "\n " (substring line chunk-start))))))
+ (org-split-string s "\n") "\n")))
+
+
+
+;;; Filters
+
+(defun org-icalendar-clear-blank-lines (headline back-end info)
+ "Remove trailing blank lines in HEADLINE export.
+HEADLINE is a string representing a transcoded headline.
+BACK-END and INFO are ignored."
+ (replace-regexp-in-string "^\\(?:[ \t]*\n\\)*" "" headline))
+
+
+
+;;; Transcode Functions
+
+;;;; Headline and Inlinetasks
+
+;; The main function is `org-icalendar-entry', which extracts
+;; information from a headline or an inlinetask (summary,
+;; description...) and then delegates code generation to
+;; `org-icalendar--vtodo' and `org-icalendar--vevent', depending
+;; on the component needed.
+
+;; Obviously, `org-icalendar--valarm' handles alarms, which can
+;; happen within a VTODO component.
+
+(defun org-icalendar-entry (entry contents info)
+ "Transcode ENTRY element into iCalendar format.
+
+ENTRY is either a headline or an inlinetask. CONTENTS is
+ignored. INFO is a plist used as a communication channel.
+
+This function is called on every headline, the section below
+it (minus inlinetasks) being its contents. It tries to create
+VEVENT and VTODO components out of scheduled date, deadline date,
+plain timestamps, diary sexps. It also calls itself on every
+inlinetask within the section."
+ (unless (org-element-property :footnote-section-p entry)
+ (let* ((type (org-element-type entry))
+ ;; Determine contents really associated to the entry. For
+ ;; a headline, limit them to section, if any. For an
+ ;; inlinetask, this is every element within the task.
+ (inside
+ (if (eq type 'inlinetask)
+ (cons 'org-data (cons nil (org-element-contents entry)))
+ (let ((first (car (org-element-contents entry))))
+ (and (eq (org-element-type first) 'section)
+ (cons 'org-data
+ (cons nil (org-element-contents first))))))))
+ (concat
+ (unless (and (plist-get info :icalendar-agenda-view)
+ (not (org-element-property :ICALENDAR-MARK entry)))
+ (let ((todo-type (org-element-property :todo-type entry))
+ (uid (or (org-element-property :ID entry) (org-id-new)))
+ (summary (org-icalendar-cleanup-string
+ (or (org-element-property :SUMMARY entry)
+ (org-export-data
+ (org-element-property :title entry) info))))
+ (loc (org-icalendar-cleanup-string
+ (org-element-property :LOCATION entry)))
+ ;; Build description of the entry from associated
+ ;; section (headline) or contents (inlinetask).
+ (desc
+ (org-icalendar-cleanup-string
+ (or (org-element-property :DESCRIPTION entry)
+ (let ((contents (org-export-data inside info)))
+ (cond
+ ((not (org-string-nw-p contents)) nil)
+ ((wholenump org-icalendar-include-body)
+ (let ((contents (org-trim contents)))
+ (substring
+ contents 0 (min (length contents)
+ org-icalendar-include-body))))
+ (org-icalendar-include-body (org-trim contents)))))))
+ (cat (org-icalendar-get-categories entry info)))
+ (concat
+ ;; Events: Delegate to `org-icalendar--vevent' to
+ ;; generate "VEVENT" component from scheduled, deadline,
+ ;; or any timestamp in the entry.
+ (let ((deadline (org-element-property :deadline entry)))
+ (and deadline
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-deadline)
+ (org-icalendar--vevent
+ entry deadline (concat "DL-" uid)
+ (concat "DL: " summary) loc desc cat)))
+ (let ((scheduled (org-element-property :scheduled entry)))
+ (and scheduled
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-scheduled)
+ (org-icalendar--vevent
+ entry scheduled (concat "SC-" uid)
+ (concat "S: " summary) loc desc cat)))
+ ;; When collecting plain timestamps from a headline and
+ ;; its title, skip inlinetasks since collection will
+ ;; happen once ENTRY is one of them.
+ (let ((counter 0))
+ (mapconcat
+ 'identity
+ (org-element-map (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'timestamp
+ (lambda (ts)
+ (let ((uid (format "TS%d-%s" (incf counter) uid)))
+ (org-icalendar--vevent entry ts uid summary loc desc cat)))
+ info nil (and (eq type 'headline) 'inlinetask))
+ ""))
+ ;; Task: First check if it is appropriate to export it.
+ ;; If so, call `org-icalendar--vtodo' to transcode it
+ ;; into a "VTODO" component.
+ (when (and todo-type
+ (case (plist-get info :with-vtodo)
+ (all t)
+ (unblocked
+ (and (eq type 'headline)
+ (not (org-icalendar-blocked-headline-p
+ entry info))))
+ ('t (eq todo-type 'todo))))
+ (org-icalendar--vtodo entry uid summary loc desc cat))
+ ;; Diary-sexp: Collect every diary-sexp element within
+ ;; ENTRY and its title, and transcode them. If ENTRY is
+ ;; a headline, skip inlinetasks: they will be handled
+ ;; separately.
+ (when org-icalendar-include-sexps
+ (let ((counter 0))
+ (mapconcat 'identity
+ (org-element-map
+ (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'diary-sexp
+ (lambda (sexp)
+ (org-icalendar-transcode-diary-sexp
+ (org-element-property :value sexp)
+ (format "DS%d-%s" (incf counter) uid)
+ summary))
+ info nil (and (eq type 'headline) 'inlinetask))
+ ""))))))
+ ;; If ENTRY is a headline, call current function on every
+ ;; inlinetask within it. In agenda export, this is independent
+ ;; from the mark (or lack thereof) on the entry.
+ (when (eq type 'headline)
+ (mapconcat 'identity
+ (org-element-map inside 'inlinetask
+ (lambda (task) (org-icalendar-entry task nil info))
+ info) ""))
+ ;; Don't forget components from inner entries.
+ contents))))
+
+(defun org-icalendar--vevent
+ (entry timestamp uid summary location description categories)
+ "Create a VEVENT component.
+
+ENTRY is either a headline or an inlinetask element. TIMESTAMP
+is a timestamp object defining the date-time of the event. UID
+is the unique identifier for the event. SUMMARY defines a short
+summary or subject for the event. LOCATION defines the intended
+venue for the event. DESCRIPTION provides the complete
+description of the event. CATEGORIES defines the categories the
+event belongs to.
+
+Return VEVENT component as a string."
+ (org-icalendar-fold-string
+ (if (eq (org-element-property :type timestamp) 'diary)
+ (org-icalendar-transcode-diary-sexp
+ (org-element-property :raw-value timestamp) uid summary)
+ (concat "BEGIN:VEVENT\n"
+ (org-icalendar-dtstamp) "\n"
+ "UID:" uid "\n"
+ (org-icalendar-convert-timestamp timestamp "DTSTART") "\n"
+ (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n"
+ ;; RRULE.
+ (when (org-element-property :repeater-type timestamp)
+ (format "RRULE:FREQ=%s;INTERVAL=%d\n"
+ (case (org-element-property :repeater-unit timestamp)
+ (hour "HOURLY") (day "DAILY") (week "WEEKLY")
+ (month "MONTHLY") (year "YEARLY"))
+ (org-element-property :repeater-value timestamp)))
+ "SUMMARY:" summary "\n"
+ (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
+ (and (org-string-nw-p description)
+ (format "DESCRIPTION:%s\n" description))
+ "CATEGORIES:" categories "\n"
+ ;; VALARM.
+ (org-icalendar--valarm entry timestamp summary)
+ "END:VEVENT"))))
+
+(defun org-icalendar--vtodo
+ (entry uid summary location description categories)
+ "Create a VTODO component.
+
+ENTRY is either a headline or an inlinetask element. UID is the
+unique identifier for the task. SUMMARY defines a short summary
+or subject for the task. LOCATION defines the intended venue for
+the task. DESCRIPTION provides the complete description of the
+task. CATEGORIES defines the categories the task belongs to.
+
+Return VTODO component as a string."
+ (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled)
+ (org-element-property :scheduled entry))
+ ;; If we can't use a scheduled time for some
+ ;; reason, start task now.
+ (let ((now (decode-time (current-time))))
+ (list 'timestamp
+ (list :type 'active
+ :minute-start (nth 1 now)
+ :hour-start (nth 2 now)
+ :day-start (nth 3 now)
+ :month-start (nth 4 now)
+ :year-start (nth 5 now)))))))
+ (org-icalendar-fold-string
+ (concat "BEGIN:VTODO\n"
+ "UID:TODO-" uid "\n"
+ (org-icalendar-dtstamp) "\n"
+ (org-icalendar-convert-timestamp start "DTSTART") "\n"
+ (and (memq 'todo-due org-icalendar-use-deadline)
+ (org-element-property :deadline entry)
+ (concat (org-icalendar-convert-timestamp
+ (org-element-property :deadline entry) "DUE")
+ "\n"))
+ "SUMMARY:" summary "\n"
+ (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
+ (and (org-string-nw-p description)
+ (format "DESCRIPTION:%s\n" description))
+ "CATEGORIES:" categories "\n"
+ "SEQUENCE:1\n"
+ (format "PRIORITY:%d\n"
+ (let ((pri (or (org-element-property :priority entry)
+ org-default-priority)))
+ (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
+ (- org-lowest-priority
+ org-highest-priority)))))))
+ (format "STATUS:%s\n"
+ (if (eq (org-element-property :todo-type entry) 'todo)
+ "NEEDS-ACTION"
+ "COMPLETED"))
+ "END:VTODO"))))
+
+(defun org-icalendar--valarm (entry timestamp summary)
+ "Create a VALARM component.
+
+ENTRY is the calendar entry triggering the alarm. TIMESTAMP is
+the start date-time of the entry. SUMMARY defines a short
+summary or subject for the task.
+
+Return VALARM component as a string, or nil if it isn't allowed."
+ ;; Create a VALARM 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,
+ ;; (c) only a DISPLAY action is defined. [ESF]
+ (let ((alarm-time
+ (let ((warntime
+ (org-element-property :APPT_WARNTIME entry)))
+ (if warntime (string-to-number warntime) 0))))
+ (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0))
+ (org-element-property :hour-start timestamp)
+ (format "BEGIN:VALARM
+ACTION:DISPLAY
+DESCRIPTION:%s
+TRIGGER:-P0DT0H%dM0S
+END:VALARM\n"
+ summary
+ (if (zerop alarm-time) org-icalendar-alarm-time alarm-time)))))
+
+
+;;;; Template
+
+(defun org-icalendar-template (contents info)
+ "Return complete document string after iCalendar conversion.
+CONTENTS is the transcoded contents string. INFO is a plist used
+as a communication channel."
+ (org-icalendar--vcalendar
+ ;; Name.
+ (if (not (plist-get info :input-file)) (buffer-name (buffer-base-buffer))
+ (file-name-nondirectory
+ (file-name-sans-extension (plist-get info :input-file))))
+ ;; Owner.
+ (if (not (plist-get info :with-author)) ""
+ (org-export-data (plist-get info :author) info))
+ ;; Timezone.
+ (if (org-string-nw-p org-icalendar-timezone) org-icalendar-timezone
+ (cadr (current-time-zone)))
+ ;; Description.
+ (org-export-data (plist-get info :title) info)
+ contents))
+
+(defun org-icalendar--vcalendar (name owner tz description contents)
+ "Create a VCALENDAR component.
+NAME, OWNER, TZ, DESCRIPTION and CONTENTS are all strings giving,
+respectively, the name of the calendar, its owner, the timezone
+used, a short description and the other components included."
+ (concat (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"
+ (org-icalendar-cleanup-string name)
+ (org-icalendar-cleanup-string owner)
+ (org-icalendar-cleanup-string tz)
+ (org-icalendar-cleanup-string description))
+ contents
+ "END:VCALENDAR\n"))
+
+
+
+;;; Interactive Functions
+
+;;;###autoload
+(defun org-icalendar-export-to-ics
+ (&optional async subtreep visible-only body-only)
+ "Export current buffer to an iCalendar file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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:VCALENDAR\" and \"END:VCALENDAR\".
+
+Return ICS file name."
+ (interactive)
+ (let ((file (buffer-file-name (buffer-base-buffer))))
+ (when (and file org-icalendar-store-UID)
+ (org-icalendar-create-uid file 'warn-user)))
+ ;; Export part. Since this back-end is backed up by `ascii', ensure
+ ;; links will not be collected at the end of sections.
+ (let ((outfile (org-export-output-file-name ".ics" subtreep)))
+ (org-export-to-file 'icalendar outfile
+ async subtreep visible-only body-only '(:ascii-charset utf-8)
+ (lambda (file)
+ (run-hook-with-args 'org-icalendar-after-save-hook file) nil))))
+
+;;;###autoload
+(defun org-icalendar-export-agenda-files (&optional async)
+ "Export all agenda files to iCalendar files.
+When optional argument ASYNC is non-nil, export happens in an
+external process."
+ (interactive)
+ (if async
+ ;; Asynchronous export is not interactive, so we will not call
+ ;; `org-check-agenda-file'. Instead we remove any non-existent
+ ;; agenda file from the list.
+ (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+ (org-export-async-start
+ (lambda (results)
+ (mapc (lambda (f) (org-export-add-to-stack f 'icalendar))
+ results))
+ `(let (output-files)
+ (mapc (lambda (file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (push (expand-file-name (org-icalendar-export-to-ics))
+ output-files)))
+ ',files)
+ output-files)))
+ (let ((files (org-agenda-files t)))
+ (org-agenda-prepare-buffers files)
+ (unwind-protect
+ (mapc (lambda (file)
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (org-icalendar-export-to-ics))))
+ files)
+ (org-release-buffers org-agenda-new-buffers)))))
+
+;;;###autoload
+(defun org-icalendar-combine-agenda-files (&optional async)
+ "Combine all agenda files into a single iCalendar file.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+The file is stored under the name chosen in
+`org-icalendar-combined-agenda-file'."
+ (interactive)
+ (if async
+ (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+ (org-export-async-start
+ (lambda (dummy)
+ (org-export-add-to-stack
+ (expand-file-name org-icalendar-combined-agenda-file)
+ 'icalendar))
+ `(apply 'org-icalendar--combine-files nil ',files)))
+ (apply 'org-icalendar--combine-files nil (org-agenda-files t))))
+
+(defun org-icalendar-export-current-agenda (file)
+ "Export current agenda view to an iCalendar FILE.
+This function assumes major mode for current buffer is
+`org-agenda-mode'."
+ (let (org-export-babel-evaluate ; Don't evaluate Babel block
+ (org-icalendar-combined-agenda-file file)
+ (marker-list
+ ;; Collect the markers pointing to entries in the current
+ ;; agenda buffer.
+ (let (markers)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((m (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker))))
+ (and m (push m markers)))
+ (beginning-of-line 2)))
+ (nreverse markers))))
+ (apply 'org-icalendar--combine-files
+ ;; Build restriction alist.
+ (let (restriction)
+ ;; Sort markers in each association within RESTRICTION.
+ (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x)
+ (dolist (m marker-list restriction)
+ (let* ((pos (marker-position m))
+ (file (buffer-file-name
+ (org-base-buffer (marker-buffer m))))
+ (file-markers (assoc file restriction)))
+ ;; Add POS in FILE association if one exists
+ ;; or create a new association for FILE.
+ (if file-markers (push pos (cdr file-markers))
+ (push (list file pos) restriction))))))
+ (org-agenda-files nil 'ifmode))))
+
+(defun org-icalendar--combine-files (restriction &rest files)
+ "Combine entries from multiple files into an iCalendar file.
+RESTRICTION, when non-nil, is an alist where key is a file name
+and value a list of buffer positions pointing to entries that
+should appear in the calendar. It only makes sense if the
+function was called from an agenda buffer. FILES is a list of
+files to build the calendar from."
+ (org-agenda-prepare-buffers files)
+ (unwind-protect
+ (progn
+ (with-temp-file org-icalendar-combined-agenda-file
+ (insert
+ (org-icalendar--vcalendar
+ ;; Name.
+ org-icalendar-combined-name
+ ;; Owner.
+ user-full-name
+ ;; Timezone.
+ (or (org-string-nw-p org-icalendar-timezone)
+ (cadr (current-time-zone)))
+ ;; Description.
+ org-icalendar-combined-description
+ ;; Contents.
+ (concat
+ ;; Agenda contents.
+ (mapconcat
+ (lambda (file)
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (let ((marks (cdr (assoc (expand-file-name file)
+ restriction))))
+ ;; Create ID if necessary.
+ (when org-icalendar-store-UID
+ (org-icalendar-create-uid file t marks))
+ (unless (and restriction (not marks))
+ ;; Add a hook adding :ICALENDAR_MARK: property
+ ;; to each entry appearing in agenda view.
+ ;; Use `apply-partially' because the function
+ ;; still has to accept one argument.
+ (let ((org-export-before-processing-hook
+ (cons (apply-partially
+ (lambda (m-list dummy)
+ (mapc (lambda (m)
+ (org-entry-put
+ m "ICALENDAR-MARK" "t"))
+ m-list))
+ (sort marks '>))
+ org-export-before-processing-hook)))
+ (org-export-as
+ 'icalendar nil nil t
+ (list :ascii-charset 'utf-8
+ :icalendar-agenda-view restriction))))))))
+ files "")
+ ;; BBDB anniversaries.
+ (when (and org-icalendar-include-bbdb-anniversaries
+ (require 'org-bbdb nil t))
+ (with-temp-buffer
+ (org-bbdb-anniv-export-ical)
+ (buffer-string)))))))
+ (run-hook-with-args 'org-icalendar-after-save-hook
+ org-icalendar-combined-agenda-file))
+ (org-release-buffers org-agenda-new-buffers)))
+
+
+(provide 'ox-icalendar)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-icalendar.el ends here
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
new file mode 100644
index 0000000000..1da7f9bbc6
--- /dev/null
+++ b/lisp/org/ox-latex.el
@@ -0,0 +1,2920 @@
+;;; ox-latex.el --- LaTeX Back-End for Org Export Engine
+
+;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 Org manual for details.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox)
+(require 'ox-publish)
+
+(defvar org-latex-default-packages-alist)
+(defvar org-latex-packages-alist)
+(defvar orgtbl-exp-regexp)
+
+
+
+;;; Define Back-End
+
+(org-export-define-backend 'latex
+ '((bold . org-latex-bold)
+ (center-block . org-latex-center-block)
+ (clock . org-latex-clock)
+ (code . org-latex-code)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (drawer . org-latex-drawer)
+ (dynamic-block . org-latex-dynamic-block)
+ (entity . org-latex-entity)
+ (example-block . org-latex-example-block)
+ (export-block . org-latex-export-block)
+ (export-snippet . org-latex-export-snippet)
+ (fixed-width . org-latex-fixed-width)
+ (footnote-definition . org-latex-footnote-definition)
+ (footnote-reference . org-latex-footnote-reference)
+ (headline . org-latex-headline)
+ (horizontal-rule . org-latex-horizontal-rule)
+ (inline-src-block . org-latex-inline-src-block)
+ (inlinetask . org-latex-inlinetask)
+ (italic . org-latex-italic)
+ (item . org-latex-item)
+ (keyword . org-latex-keyword)
+ (latex-environment . org-latex-latex-environment)
+ (latex-fragment . org-latex-latex-fragment)
+ (line-break . org-latex-line-break)
+ (link . org-latex-link)
+ (paragraph . org-latex-paragraph)
+ (plain-list . org-latex-plain-list)
+ (plain-text . org-latex-plain-text)
+ (planning . org-latex-planning)
+ (property-drawer . (lambda (&rest args) ""))
+ (quote-block . org-latex-quote-block)
+ (quote-section . org-latex-quote-section)
+ (radio-target . org-latex-radio-target)
+ (section . org-latex-section)
+ (special-block . org-latex-special-block)
+ (src-block . org-latex-src-block)
+ (statistics-cookie . org-latex-statistics-cookie)
+ (strike-through . org-latex-strike-through)
+ (subscript . org-latex-subscript)
+ (superscript . org-latex-superscript)
+ (table . org-latex-table)
+ (table-cell . org-latex-table-cell)
+ (table-row . org-latex-table-row)
+ (target . org-latex-target)
+ (template . org-latex-template)
+ (timestamp . org-latex-timestamp)
+ (underline . org-latex-underline)
+ (verbatim . org-latex-verbatim)
+ (verse-block . org-latex-verse-block))
+ :export-block '("LATEX" "TEX")
+ :menu-entry
+ '(?l "Export to LaTeX"
+ ((?L "As LaTeX buffer" org-latex-export-as-latex)
+ (?l "As LaTeX file" org-latex-export-to-latex)
+ (?p "As PDF file" org-latex-export-to-pdf)
+ (?o "As PDF file and open"
+ (lambda (a s v b)
+ (if a (org-latex-export-to-pdf t s v b)
+ (org-open-file (org-latex-export-to-pdf nil s v b)))))))
+ :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
+ (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t)
+ (:latex-header "LATEX_HEADER" nil nil newline)
+ (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline)
+ (:latex-hyperref-p nil "texht" org-latex-with-hyperref t)
+ ;; Redefine regular options.
+ (:date "DATE" nil "\\today" t)))
+
+
+
+;;; Internal Variables
+
+(defconst org-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")
+ ("nb" . "norsk")
+ ("nn" . "nynorsk")
+ ("no" . "norsk")
+ ("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.")
+
+(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr")
+ ("qbordermatrix" . "\\cr")
+ ("kbordermatrix" . "\\\\"))
+ "Alist between matrix macros and their row ending.")
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-latex nil
+ "Options for exporting Org mode files to LaTeX."
+ :tag "Org Export LaTeX"
+ :group 'org-export)
+
+
+;;;; Preamble
+
+(defcustom org-latex-default-class "article"
+ "The default LaTeX class."
+ :group 'org-export-latex
+ :type '(string :tag "LaTeX class"))
+
+(defcustom org-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-latex-default-packages-alist' and
+ `org-latex-packages-alist'. Thus, your header definitions
+ should avoid to also request these packages.
+
+- Lines specified via \"#+LATEX_HEADER:\" and
+ \"#+LATEX_HEADER_EXTRA:\" keywords.
+
+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(_EXTRA)
+ [NO-EXTRA] do not include #+LATEX_HEADER(_EXTRA) 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 and #+LATEX_HEADER_EXTRA lines, then have a call
+to \\providecommand, and then place \\usepackage commands based
+on the content of `org-latex-packages-alist'.
+
+If your header, `org-latex-default-packages-alist' or
+`org-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-latex-inputenc-alist' for a way to influence this mechanism.
+
+Likewise, if your header contains \"\\usepackage[AUTO]{babel}\",
+AUTO will be replaced with the language related to the language
+code specified by `org-export-default-language', which see. Note
+that constructions such as \"\\usepackage[french,AUTO,english]{babel}\"
+are permitted.
+
+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-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-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
+ :type '(repeat
+ (cons
+ (string :tag "Derived from buffer")
+ (string :tag "Use this instead"))))
+
+(defcustom org-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-latex
+ :type 'string)
+
+(defcustom org-latex-toc-command "\\tableofcontents\n\n"
+ "LaTeX command to set the table of contents, list of figures, etc.
+This command only applies to the table of contents generated with
+the toc:nil option, not to those generated with #+TOC keyword."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-with-hyperref t
+ "Toggle insertion of \\hypersetup{...} in the preamble."
+ :group 'org-export-latex
+ :type 'boolean)
+
+;;;; Headline
+
+(defcustom org-latex-format-headline-function
+ 'org-latex-format-headline-default-function
+ "Function for formatting the headline's 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.
+
+Use `org-latex-format-headline-default-function' by default,
+which format headlines like for Org version prior to 8.0."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+;;;; Footnotes
+
+(defcustom org-latex-footnote-separator "\\textsuperscript{,}\\,"
+ "Text used to separate footnotes."
+ :group 'org-export-latex
+ :type 'string)
+
+
+;;;; Timestamps
+
+(defcustom org-latex-active-timestamp-format "\\textit{%s}"
+ "A printf format string to be applied to active timestamps."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-inactive-timestamp-format "\\textit{%s}"
+ "A printf format string to be applied to inactive timestamps."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-diary-timestamp-format "\\textit{%s}"
+ "A printf format string to be applied to diary timestamps."
+ :group 'org-export-latex
+ :type 'string)
+
+
+;;;; Links
+
+(defcustom org-latex-image-default-option ""
+ "Default option for images."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-latex-image-default-width ".9\\linewidth"
+ "Default width for images.
+This value will not be used if a height is provided."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-latex-image-default-height ""
+ "Default height for images.
+This value will not be used if a width is provided, or if the
+image is wrapped within a \"figure\" or \"wrapfigure\"
+environment."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-latex-default-figure-position "htb"
+ "Default position for latex figures."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-inline-image-rules
+ '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'"))
+ "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-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+(defcustom org-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-latex-default-table-environment "tabular"
+ "Default environment used to build tables."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-latex-default-table-mode 'table
+ "Default mode for tables.
+
+Value can be a symbol among:
+
+ `table' Regular LaTeX table.
+
+ `math' In this mode, every cell is considered as being in math
+ mode and the complete table will be wrapped within a math
+ environment. It is particularly useful to write matrices.
+
+ `inline-math' This mode is almost the same as `math', but the
+ math environment will be inlined.
+
+ `verbatim' The table is exported as it appears in the Org
+ buffer, within a verbatim environment.
+
+This value can be overridden locally with, i.e. \":mode math\" in
+LaTeX attributes.
+
+When modifying this variable, it may be useful to change
+`org-latex-default-table-environment' accordingly."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice (const :tag "Table" table)
+ (const :tag "Matrix" math)
+ (const :tag "Inline matrix" inline-math)
+ (const :tag "Verbatim" verbatim)))
+
+(defcustom org-latex-tables-centered t
+ "When non-nil, tables are exported in a center environment."
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-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 t\" and \":booktabs nil\" LaTeX
+attributes."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-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-latex
+ :type 'boolean)
+
+(defcustom org-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-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting")))
+
+
+;;;; Text markup
+
+(defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}")
+ (code . verb)
+ (italic . "\\emph{%s}")
+ (strike-through . "\\sout{%s}")
+ (underline . "\\uline{%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-latex
+ :type 'alist
+ :options '(bold code italic strike-through underline verbatim))
+
+
+;;;; Drawers
+
+(defcustom org-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-latex-format-drawer-default \(name contents\)
+ \"Format a drawer element for LaTeX export.\"
+ contents\)"
+ :group 'org-export-latex
+ :type 'function)
+
+
+;;;; Inlinetasks
+
+(defcustom org-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-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-latex
+ :type 'function)
+
+
+;; Src blocks
+
+(defcustom org-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-latex-packages-alist', for
+example using customize, or with something like:
+
+ \(require 'ox-latex)
+ \(add-to-list 'org-latex-packages-alist '(\"\" \"listings\"))
+ \(add-to-list 'org-latex-packages-alist '(\"\" \"color\"))
+
+Alternatively,
+
+ \(setq org-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-latex-packages-alist', for example
+using customize, or with
+
+ \(require 'ox-latex)
+ \(add-to-list 'org-latex-packages-alist '(\"\" \"minted\"))
+
+In addition, it is necessary to install pygments
+\(http://pygments.org), and to configure the variable
+`org-latex-pdf-process' so that the -shell-escape option is
+passed to pdflatex.
+
+The minted choice has possible repercussions on the preview of
+latex fragments (see `org-preview-latex-fragment'). If you run
+into previewing problems, please consult
+
+ http://orgmode.org/worg/org-tutorials/org-latex-preview.html"
+ :group 'org-export-latex
+ :type '(choice
+ (const :tag "Use listings" t)
+ (const :tag "Use minted" minted)
+ (const :tag "Export verbatim" nil)))
+
+(defcustom org-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 "[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-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-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
+ :type '(repeat
+ (list
+ (string :tag "Listings option name ")
+ (string :tag "Listings option value"))))
+
+(defcustom org-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
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Minted language"))))
+
+(defcustom org-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-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
+ :type '(repeat
+ (list
+ (string :tag "Minted option name ")
+ (string :tag "Minted option value"))))
+
+(defvar org-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-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}")
+
+
+;;;; Compilation
+
+(defcustom org-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 directory
+and extension parts) 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 as it automates the LaTeX
+build process by calling the \"correct\" combinations of
+auxiliary programs. Org does offer `texi2dvi' as one of the
+customize options. Alternatively, `rubber' and `latexmk' also
+provide similar functionality. The latter supports `biber' out
+of the box.
+
+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 -V %f"))
+ (const :tag "rubber"
+ ("rubber -d --into %o %f"))
+ (const :tag "latexmk"
+ ("latexmk -g -pdf %f"))
+ (function)))
+
+(defcustom org-latex-logfiles-extensions
+ '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
+ "The list of file extensions to consider as LaTeX logfiles.
+The logfiles will be remove if `org-latex-remove-logfiles' is
+non-nil."
+ :group 'org-export-latex
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-latex-remove-logfiles t
+ "Non-nil means remove the logfiles produced by PDF production.
+By default, logfiles are files with these extensions: .aux, .idx,
+.log, .out, .toc, .nav, .snm and .vrb. To define the set of
+logfiles to remove, set `org-latex-logfiles-extensions'."
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-latex-known-errors
+ '(("Reference.*?undefined" . "[undefined reference]")
+ ("Citation.*?undefined" . "[undefined citation]")
+ ("Undefined control sequence" . "[undefined control sequence]")
+ ("^! LaTeX.*?Error" . "[LaTeX error]")
+ ("^! Package.*?Error" . "[package error]")
+ ("Runaway argument" . "Runaway argument"))
+ "Alist of regular expressions and associated messages for the user.
+The regular expressions are used to find possible errors in the
+log of a latex-run."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(repeat
+ (cons
+ (string :tag "Regexp")
+ (string :tag "Message"))))
+
+
+
+;;; Internal Functions
+
+(defun org-latex--caption/label-string (element info)
+ "Return caption and label LaTeX string for ELEMENT.
+
+INFO is a plist holding contextual information. If there's no
+caption nor label, return the empty string.
+
+For non-floats, see `org-latex--wrap-label'."
+ (let* ((label (org-element-property :name element))
+ (label-str (if (not (org-string-nw-p label)) ""
+ (format "\\label{%s}"
+ (org-export-solidify-link-text label))))
+ (main (org-export-get-caption element))
+ (short (org-export-get-caption element t))
+ (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption)))
+ (cond
+ ((org-string-nw-p caption-from-attr-latex)
+ (concat caption-from-attr-latex "\n"))
+ ((and (not main) (equal label-str "")) "")
+ ((not main) (concat label-str "\n"))
+ ;; Option caption format with short name.
+ (short (format "\\caption[%s]{%s%s}\n"
+ (org-export-data short info)
+ label-str
+ (org-export-data main info)))
+ ;; Standard caption format.
+ (t (format "\\caption{%s%s}\n" label-str (org-export-data main info))))))
+
+(defun org-latex-guess-inputenc (header)
+ "Set the coding system in inputenc to what the buffer is.
+
+HEADER is the LaTeX header string. This function only applies
+when specified inputenc option is \"AUTO\".
+
+Return the new header, as a string."
+ (let* ((cs (or (ignore-errors
+ (latexenc-coding-system-to-inputenc
+ (or org-export-coding-system buffer-file-coding-system)))
+ "utf8")))
+ (if (not cs) header
+ ;; First translate if that is requested.
+ (setq cs (or (cdr (assoc cs org-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-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.
+
+The argument to Babel may be \"AUTO\" which is then replaced with
+the language of the document or `org-export-default-language'
+unless language in question is already loaded.
+
+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) ",[ \t]*")))
+ (language (cdr (assoc language-code
+ org-latex-babel-language-alist))))
+ ;; If LANGUAGE is already loaded, return header without AUTO.
+ ;; Otherwise, replace AUTO with language or append language if
+ ;; AUTO is not present.
+ (replace-match
+ (mapconcat (lambda (option) (if (equal "AUTO" option) language option))
+ (cond ((member language options) (delete "AUTO" options))
+ ((member "AUTO" options) options)
+ (t (append options (list language))))
+ ", ")
+ t nil header 1)))))
+
+(defun org-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-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-latex--wrap-label (element output)
+ "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
+This function shouldn't be used for floats. See
+`org-latex--caption/label-string'."
+ (let ((label (org-element-property :name element)))
+ (if (not (and (org-string-nw-p output) (org-string-nw-p label))) output
+ (concat (format "\\label{%s}\n" (org-export-solidify-link-text label))
+ output))))
+
+(defun org-latex--text-markup (text markup)
+ "Format TEXT depending on MARKUP text markup.
+See `org-latex-text-markup-alist' for details."
+ (let ((fmt (cdr (assq markup org-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-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-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-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))
+ (header (nth 1 (assoc class org-latex-classes)))
+ (document-class-string
+ (and (stringp header)
+ (if (not class-options) header
+ (replace-regexp-in-string
+ "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
+ class-options header t nil 1)))))
+ (if (not document-class-string)
+ (user-error "Unknown LaTeX class `%s'" class)
+ (org-latex-guess-babel-language
+ (org-latex-guess-inputenc
+ (org-element-normalize-string
+ (org-splice-latex-header
+ document-class-string
+ org-latex-default-packages-alist
+ org-latex-packages-alist nil
+ (concat (org-element-normalize-string
+ (plist-get info :latex-header))
+ (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))
+ ((or author email) (format "\\author{%s}\n" (or author email)))))
+ ;; Date.
+ (let ((date (and (plist-get info :with-date) (org-export-get-date info))))
+ (format "\\date{%s}\n" (org-export-data date info)))
+ ;; Title
+ (format "\\title{%s}\n" title)
+ ;; Hyperref options.
+ (when (plist-get info :latex-hyperref-p)
+ (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-latex-title-command)) nil)
+ ((string-match "\\(?:[^%]\\|^\\)%s"
+ org-latex-title-command)
+ (format org-latex-title-command title))
+ (t org-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))
+ org-latex-toc-command)))
+ ;; 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
+
+;;;; Bold
+
+(defun org-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-latex--text-markup contents 'bold))
+
+
+;;;; Center Block
+
+(defun org-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-latex--wrap-label
+ center-block
+ (format "\\begin{center}\n%s\\end{center}" contents)))
+
+
+;;;; Clock
+
+(defun org-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-latex-inactive-timestamp-format
+ (concat (org-translate-time
+ (org-element-property :raw-value
+ (org-element-property :value clock)))
+ (let ((time (org-element-property :duration clock)))
+ (and time (format " (%s)" time)))))
+ "\\\\"))
+
+
+;;;; Code
+
+(defun org-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-latex--text-markup (org-element-property :value code) 'code))
+
+
+;;;; Drawer
+
+(defun org-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-latex-format-drawer-function)
+ (funcall org-latex-format-drawer-function
+ name contents)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents)))
+ (org-latex--wrap-label drawer output)))
+
+
+;;;; Dynamic Block
+
+(defun org-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-latex--wrap-label dynamic-block contents))
+
+
+;;;; Entity
+
+(defun org-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-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."
+ (when (org-string-nw-p (org-element-property :value example-block))
+ (org-latex--wrap-label
+ example-block
+ (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-export-format-code-default example-block info)))))
+
+
+;;;; Export Block
+
+(defun org-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 (member (org-element-property :type export-block) '("LATEX" "TEX"))
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Export Snippet
+
+(defun org-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) 'latex)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Fixed Width
+
+(defun org-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-latex--wrap-label
+ fixed-width
+ (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-remove-indentation
+ (org-element-property :value fixed-width)))))
+
+
+;;;; Footnote Reference
+
+(defun org-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-latex-footnote-separator))
+ (cond
+ ;; 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, footnote definition or table cell.
+ ((loop for parent in (org-export-get-genealogy footnote-reference)
+ thereis (memq (org-element-type parent)
+ '(footnote-reference footnote-definition table-cell)))
+ "\\footnotemark")
+ ;; Otherwise, define it with \footnote command.
+ (t
+ (let ((def (org-export-get-footnote-definition footnote-reference info)))
+ (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-latex--delayed-footnotes-definitions def info)))))))
+
+
+;;;; Headline
+
+(defun org-latex-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to LaTeX.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (unless (org-element-property :footnote-section-p headline)
+ (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-latex-classes))
+ ;; Section formatting will set two placeholders: one for
+ ;; the title and the other for the contents.
+ (section-fmt
+ (let ((sec (if (functionp (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. Add
+ ;; placeholder for contents.
+ ((stringp sec) (concat sec "\n%s"))
+ ;; (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 toc.
+ (full-text (funcall org-latex-format-headline-function
+ todo todo-type priority text tags))
+ ;; Associate \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)))
+ (if (or (not section-fmt) (org-export-low-level-p headline info))
+ ;; 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.
+ (let ((low-level-body
+ (concat
+ ;; If 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)))
+ ;; This is a standard headline. Export it as a section. Add
+ ;; an alternative heading when possible, and when this is not
+ ;; identical to the usual heading.
+ (let ((opt-title
+ (funcall org-latex-format-headline-function
+ todo todo-type priority
+ (org-export-data
+ (org-export-get-alt-title headline info) info)
+ (and (eq (plist-get info :with-tags) t) tags))))
+ (if (and numberedp opt-title
+ (not (equal opt-title full-text))
+ (string-match "\\`\\\\\\(.*?[^*]\\){" section-fmt))
+ (format (replace-match "\\1[%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 "\\]" ")" opt-title))
+ full-text
+ (concat headline-label pre-blanks contents))
+ ;; Impossible to add an alternative heading. Fallback to
+ ;; regular sectioning format string.
+ (format section-fmt full-text
+ (concat headline-label pre-blanks contents))))))))
+
+(defun org-latex-format-headline-default-function
+ (todo todo-type priority text tags)
+ "Default format function for a headline.
+See `org-latex-format-headline-function' for details."
+ (concat
+ (and todo (format "{\\bfseries\\sffamily %s} " todo))
+ (and priority (format "\\framebox{\\#%c} " priority))
+ text
+ (and tags
+ (format "\\hfill{}\\textsc{%s}" (mapconcat 'identity tags ":")))))
+
+
+;;;; Horizontal Rule
+
+(defun org-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-latex--wrap-label
+ horizontal-rule
+ (format "\\rule{%s}{%s}"
+ (or (plist-get attr :width) "\\linewidth")
+ (or (plist-get attr :thickness) "0.5pt"))))))
+
+
+;;;; Inline Src Block
+
+(defun org-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-latex--find-verb-separator code)))
+ (cond
+ ;; Do not use a special package: transcode it verbatim.
+ ((not org-latex-listings)
+ (concat "\\verb" separator code separator))
+ ;; Use minted package.
+ ((eq org-latex-listings 'minted)
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (mint-lang (or (cadr (assq (intern org-lang)
+ org-latex-minted-langs))
+ org-lang))
+ (options (org-latex--make-option-string
+ org-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-latex-listings-langs))
+ org-lang))
+ (options (org-latex--make-option-string
+ (append org-latex-listings-options
+ `(("language" ,lst-lang))))))
+ (concat (format "\\lstinline[%s]" options)
+ separator code separator))))))
+
+
+;;;; Inlinetask
+
+(defun org-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-latex-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ (if (functionp org-latex-format-inlinetask-function)
+ (funcall org-latex-format-inlinetask-function
+ todo todo-type priority title tags contents)
+ ;; Otherwise, use a default template.
+ (org-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-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-latex--text-markup contents 'italic))
+
+
+;;;; Item
+
+(defun org-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
+ ;; Determine level of current item to determine the
+ ;; correct LaTeX counter to use (enumi, enumii...).
+ (let ((parent item) (level 0))
+ (while (memq (org-element-type
+ (setq parent (org-export-get-parent parent)))
+ '(plain-list item))
+ (when (and (eq (org-element-type parent) 'plain-list)
+ (eq (org-element-property :type parent)
+ 'ordered))
+ (incf level)))
+ level)))
+ (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 "$\\square$ ")
+ (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-latex--delayed-footnotes-definitions
+ (org-element-property :tag item) info)))))
+
+
+;;;; Keyword
+
+(defun org-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))
+ ((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= "listings" value)
+ (cond
+ ((eq org-latex-listings 'minted) "\\listoflistings")
+ (org-latex-listings "\\lstlistoflistings")
+ ;; At the moment, src blocks with a caption are wrapped
+ ;; into a figure environment.
+ (t "\\listoffigures")))))))))
+
+
+;;;; Latex Environment
+
+(defun org-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."
+ (when (plist-get info :with-latex)
+ (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" (org-export-solidify-link-text label)))
+ (buffer-string))))))
+
+
+;;;; Latex Fragment
+
+(defun org-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."
+ (when (plist-get info :with-latex)
+ (org-element-property :value latex-fragment)))
+
+
+;;;; Line Break
+
+(defun org-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."
+ "\\\\\n")
+
+
+;;;; Link
+
+(defun org-latex--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))))
+ (filetype (file-name-extension path))
+ (caption (org-latex--caption/label-string parent info))
+ ;; Retrieve latex attributes from the element around.
+ (attr (org-export-read-attribute :attr_latex parent))
+ (float (let ((float (plist-get attr :float)))
+ (cond ((and (not float) (plist-member attr :float)) nil)
+ ((string= float "wrap") 'wrap)
+ ((string= float "multicolumn") 'multicolumn)
+ ((or float
+ (org-element-property :caption parent)
+ (org-string-nw-p (plist-get attr :caption)))
+ 'figure))))
+ (placement
+ (let ((place (plist-get attr :placement)))
+ (cond (place (format "%s" place))
+ ((eq float 'wrap) "{l}{0.5\\textwidth}")
+ ((eq float 'figure)
+ (format "[%s]" org-latex-default-figure-position))
+ (t ""))))
+ (comment-include (if (plist-get attr :comment-include) "%" ""))
+ ;; It is possible to specify width and height in the
+ ;; ATTR_LATEX line, and also via default variables.
+ (width (cond ((plist-get attr :width))
+ ((plist-get attr :height) "")
+ ((eq float 'wrap) "0.48\\textwidth")
+ (t org-latex-image-default-width)))
+ (height (cond ((plist-get attr :height))
+ ((or (plist-get attr :width)
+ (memq float '(figure wrap))) "")
+ (t org-latex-image-default-height)))
+ (options (let ((opt (or (plist-get attr :options)
+ org-latex-image-default-option)))
+ (if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt
+ (match-string 1 opt))))
+ image-code)
+ (if (member filetype '("tikz" "pgf"))
+ ;; For tikz images:
+ ;; - use \input to read in image file.
+ ;; - if options are present, wrap in a tikzpicture environment.
+ ;; - if width or height are present, use \resizebox to change
+ ;; the image size.
+ (progn
+ (setq image-code (format "\\input{%s}" path))
+ (when (org-string-nw-p options)
+ (setq image-code
+ (format "\\begin{tikzpicture}[%s]\n%s\n\\end{tikzpicture}"
+ options
+ image-code)))
+ (when (or (org-string-nw-p width) (org-string-nw-p height))
+ (setq image-code (format "\\resizebox{%s}{%s}{%s}"
+ (if (org-string-nw-p width) width "!")
+ (if (org-string-nw-p height) height "!")
+ image-code))))
+ ;; For other images:
+ ;; - add width and height to options.
+ ;; - include the image with \includegraphics.
+ (when (org-string-nw-p width)
+ (setq options (concat options ",width=" width)))
+ (when (org-string-nw-p height)
+ (setq options (concat options ",height=" height)))
+ (setq image-code
+ (format "\\includegraphics%s{%s}"
+ (cond ((not (org-string-nw-p options)) "")
+ ((= (aref options 0) ?,)
+ (format "[%s]"(substring options 1)))
+ (t (format "[%s]" options)))
+ path))
+ (when (equal filetype "svg")
+ (setq image-code (replace-regexp-in-string "^\\\\includegraphics"
+ "\\includesvg"
+ image-code
+ nil t))
+ (setq image-code (replace-regexp-in-string "\\.svg}"
+ "}"
+ image-code
+ nil t))))
+ ;; Return proper string, depending on FLOAT.
+ (case float
+ (wrap (format "\\begin{wrapfigure}%s
+\\centering
+%s%s
+%s\\end{wrapfigure}" placement comment-include image-code caption))
+ (multicolumn (format "\\begin{figure*}%s
+\\centering
+%s%s
+%s\\end{figure*}" placement comment-include image-code caption))
+ (figure (format "\\begin{figure}%s
+\\centering
+%s%s
+%s\\end{figure}" placement comment-include image-code caption))
+ (otherwise image-code))))
+
+(defun org-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-latex-inline-image-rules))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ (if (not (file-name-absolute-p raw-path)) raw-path
+ (concat "file://" (expand-file-name raw-path))))
+ (t raw-path)))
+ protocol)
+ (cond
+ ;; Image file.
+ (imagep (org-latex--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 a 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{%s}{%s}" destination desc)
+ (format "\\url{%s}" destination)))
+ ;; Fuzzy link points nowhere.
+ ('nil
+ (format org-latex-link-with-unknown-path-format
+ (or desc
+ (org-export-data
+ (org-element-property :raw-link link) info))))
+ ;; LINK points to a 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-latex-link-with-unknown-path-format desc)))))
+
+
+;;;; Paragraph
+
+(defun org-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-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))
+ (attr (org-export-read-attribute :attr_latex plain-list))
+ (latex-type (let ((env (plist-get attr :environment)))
+ (cond (env (format "%s" env))
+ ((eq type 'ordered) "enumerate")
+ ((eq type 'unordered) "itemize")
+ ((eq type 'descriptive) "description")))))
+ (org-latex--wrap-label
+ plain-list
+ (format "\\begin{%s}%s\n%s\\end{%s}"
+ latex-type
+ ;; Put optional arguments, if any inside square brackets
+ ;; when necessary.
+ (let ((options (format "%s" (or (plist-get attr :options) ""))))
+ (cond ((equal options "") "")
+ ((string-match "\\`\\[.*\\]\\'" options) options)
+ (t (format "[%s]" options))))
+ contents
+ latex-type))))
+
+
+;;;; Plain Text
+
+(defun org-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."
+ (let ((specialp (plist-get info :with-special-strings))
+ (output text))
+ ;; Protect %, #, &, $, _, { and }.
+ (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}_]\\)" output)
+ (setq output
+ (replace-match
+ (format "\\%s" (match-string 2 output)) nil t output 2)))
+ ;; Protect ^.
+ (setq output
+ (replace-regexp-in-string
+ "\\([^\\]\\|^\\)\\(\\^\\)" "\\\\^{}" output nil nil 2))
+ ;; Protect \. If special strings are used, be careful not to
+ ;; protect "\" in "\-" constructs.
+ (let ((symbols (if specialp "-%$#&{}^_\\" "%$#&{}^_\\")))
+ (setq output
+ (replace-regexp-in-string
+ (format "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%s]\\|$\\)" symbols)
+ "$\\backslash$" output nil t 1)))
+ ;; Protect ~.
+ (setq output
+ (replace-regexp-in-string
+ "\\([^\\]\\|^\\)\\(~\\)" "\\textasciitilde{}" output nil t 2))
+ ;; Activate smart quotes. Be sure to provide original TEXT string
+ ;; since OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output (org-export-activate-smart-quotes output :latex info text)))
+ ;; LaTeX into \LaTeX{} and TeX into \TeX{}.
+ (let ((case-fold-search nil)
+ (start 0))
+ (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" output start)
+ (setq output (replace-match
+ (format "\\%s{}" (match-string 1 output)) nil t output)
+ start (match-end 0))))
+ ;; Convert special strings.
+ (when specialp
+ (setq output
+ (replace-regexp-in-string "\\.\\.\\." "\\ldots{}" output nil t)))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" output)))
+ ;; Return value.
+ output))
+
+
+;;;; Planning
+
+(defun org-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-latex-inactive-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value closed))))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "\\textbf{%s} " org-deadline-string)
+ (format org-latex-active-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value deadline))))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "\\textbf{%s} " org-scheduled-string)
+ (format org-latex-active-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value scheduled))))))))
+ " ")
+ "\\\\"))
+
+
+;;;; Quote Block
+
+(defun org-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-latex--wrap-label
+ quote-block
+ (format "\\begin{quote}\n%s\\end{quote}" contents)))
+
+
+;;;; Quote Section
+
+(defun org-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-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-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-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)))
+ (opt (org-export-read-attribute :attr_latex special-block :options)))
+ (concat (format "\\begin{%s}%s\n" type (or opt ""))
+ ;; Insert any label or caption within the block
+ ;; (otherwise, a reference pointing to that element will
+ ;; count the section instead).
+ (org-latex--caption/label-string special-block info)
+ contents
+ (format "\\end{%s}" type))))
+
+
+;;;; Src Block
+
+(defun org-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."
+ (when (org-string-nw-p (org-element-property :value src-block))
+ (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-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))
+ (attributes (org-export-read-attribute :attr_latex src-block))
+ (float (plist-get attributes :float)))
+ (cond
+ ;; Case 1. No source fontification.
+ ((not org-latex-listings)
+ (let* ((caption-str (org-latex--caption/label-string src-block info))
+ (float-env
+ (cond ((and (not float) (plist-member attributes :float)) "%s")
+ ((string= "multicolumn" float)
+ (format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}"
+ org-latex-default-figure-position
+ caption-str))
+ ((or caption float)
+ (format "\\begin{figure}[H]\n%%s%s\n\\end{figure}"
+ caption-str))
+ (t "%s"))))
+ (format
+ float-env
+ (concat (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-latex-listings 'minted)
+ (let* ((caption-str (org-latex--caption/label-string src-block info))
+ (float-env
+ (cond ((and (not float) (plist-member attributes :float)) "%s")
+ ((string= "multicolumn" float)
+ (format "\\begin{listing*}\n%%s\n%s\\end{listing*}"
+ caption-str))
+ ((or caption float)
+ (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}"
+ caption-str))
+ (t "%s")))
+ (body
+ (format
+ "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
+ ;; Options.
+ (org-latex--make-option-string
+ (if (or (not num-start)
+ (assoc "linenos" org-latex-minted-options))
+ org-latex-minted-options
+ (append
+ `(("linenos")
+ ("firstnumber" ,(number-to-string (1+ num-start))))
+ org-latex-minted-options)))
+ ;; Language.
+ (or (cadr (assq (intern lang) org-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)
+ ?\s)
+ (format "(%s)" ref)))))
+ nil (and retain-labels (cdr code-info)))))))
+ ;; Return value.
+ (format float-env body)))
+ ;; Case 4. Use listings package.
+ (t
+ (let ((lst-lang
+ (or (cadr (assq (intern lang) org-latex-listings-langs)) lang))
+ (caption-str
+ (when caption
+ (let ((main (org-export-get-caption src-block))
+ (secondary (org-export-get-caption src-block t)))
+ (if (not secondary)
+ (format "{%s}" (org-export-data main info))
+ (format "{[%s]%s}"
+ (org-export-data secondary info)
+ (org-export-data main info)))))))
+ (concat
+ ;; Options.
+ (format
+ "\\lstset{%s}\n"
+ (org-latex--make-option-string
+ (append
+ org-latex-listings-options
+ (cond
+ ((and (not float) (plist-member attributes :float)) nil)
+ ((string= "multicolumn" float) '(("float" "*")))
+ ((and float (not (assoc "float" org-latex-listings-options)))
+ `(("float" ,org-latex-default-figure-position))))
+ `(("language" ,lst-lang))
+ (when label `(("label" ,label)))
+ (when caption-str `(("caption" ,caption-str)))
+ (cond ((assoc "numbers" org-latex-listings-options) nil)
+ ((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-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-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-latex--text-markup contents 'strike-through))
+
+
+;;;; Subscript
+
+(defun org-latex--script-size (object info)
+ "Transcode a subscript or superscript object.
+OBJECT is an Org object. INFO is a plist used as a communication
+channel."
+ (let ((in-script-p
+ ;; Non-nil if object is already in a sub/superscript.
+ (let ((parent object))
+ (catch 'exit
+ (while (setq parent (org-export-get-parent parent))
+ (let ((type (org-element-type parent)))
+ (cond ((memq type '(subscript superscript))
+ (throw 'exit t))
+ ((memq type org-element-all-elements)
+ (throw 'exit nil))))))))
+ (type (org-element-type object))
+ (output ""))
+ (org-element-map (org-element-contents object)
+ (cons 'plain-text org-element-all-objects)
+ (lambda (obj)
+ (case (org-element-type obj)
+ ((entity latex-fragment)
+ (let ((data (org-trim (org-export-data obj info))))
+ (string-match
+ "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'"
+ data)
+ (setq output
+ (concat output
+ (match-string 1 data)
+ (let ((blank (org-element-property :post-blank obj)))
+ (and blank (> blank 0) "\\ "))))))
+ (plain-text
+ (setq output
+ (format "%s\\text{%s}" output (org-export-data obj info))))
+ (otherwise
+ (setq output
+ (concat output
+ (org-export-data obj info)
+ (let ((blank (org-element-property :post-blank obj)))
+ (and blank (> blank 0) "\\ ")))))))
+ info nil org-element-recursive-objects)
+ ;; Result. Do not wrap into math mode if already in a subscript
+ ;; or superscript. Do not wrap into curly brackets if OUTPUT is
+ ;; a single character. Also merge consecutive subscript and
+ ;; superscript into the same math snippet.
+ (concat (and (not in-script-p)
+ (let ((prev (org-export-get-previous-element object info)))
+ (or (not prev)
+ (not (eq (org-element-type prev)
+ (if (eq type 'subscript) 'superscript
+ 'subscript)))
+ (let ((blank (org-element-property :post-blank prev)))
+ (and blank (> blank 0)))))
+ "$")
+ (if (eq (org-element-type object) 'subscript) "_" "^")
+ (and (> (length output) 1) "{")
+ output
+ (and (> (length output) 1) "}")
+ (and (not in-script-p)
+ (or (let ((blank (org-element-property :post-blank object)))
+ (and blank (> blank 0)))
+ (not (eq (org-element-type
+ (org-export-get-next-element object info))
+ (if (eq type 'subscript) 'superscript
+ 'subscript))))
+ "$"))))
+
+(defun org-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."
+ (org-latex--script-size subscript info))
+
+
+;;;; Superscript
+
+(defun org-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."
+ (org-latex--script-size superscript info))
+
+
+;;;; Table
+;;
+;; `org-latex-table' is the entry point for table transcoding. It
+;; takes care of tables with a "verbatim" mode. Otherwise, it
+;; delegates the job to either `org-latex--table.el-table',
+;; `org-latex--org-table' or `org-latex--math-table' functions,
+;; depending of the type of the table and the mode requested.
+;;
+;; `org-latex--align-string' is a subroutine used to build alignment
+;; string for Org tables.
+
+(defun org-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."
+ (if (eq (org-element-property :type table) 'table.el)
+ ;; "table.el" table. Convert it using appropriate tools.
+ (org-latex--table.el-table table info)
+ (let ((type (or (org-export-read-attribute :attr_latex table :mode)
+ org-latex-default-table-mode)))
+ (cond
+ ;; Case 1: Verbatim table.
+ ((string= type "verbatim")
+ (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: Matrix.
+ ((or (string= type "math") (string= type "inline-math"))
+ (org-latex--math-table table info))
+ ;; Case 3: Standard table.
+ (t (concat (org-latex--org-table table contents info)
+ ;; When there are footnote references within the
+ ;; table, insert their definition just after it.
+ (org-latex--delayed-footnotes-definitions table info)))))))
+
+(defun org-latex--align-string (table info)
+ "Return an appropriate LaTeX alignment string.
+TABLE is the considered table. INFO is a plist used as
+a communication channel."
+ (or (org-export-read-attribute :attr_latex table :align)
+ (let (align)
+ ;; 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 align))
+ (push "|" align))
+ (push (case (org-export-table-cell-alignment cell info)
+ (left "l")
+ (right "r")
+ (center "c"))
+ align)
+ (when (memq 'right borders) (push "|" align))))
+ info)
+ (apply 'concat (nreverse align)))))
+
+(defun org-latex--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' property and
+`table' as its `:mode' attribute."
+ (let* ((caption (org-latex--caption/label-string table info))
+ (attr (org-export-read-attribute :attr_latex table))
+ ;; Determine alignment string.
+ (alignment (org-latex--align-string table info))
+ ;; Determine environment for the table: longtable, tabular...
+ (table-env (or (plist-get attr :environment)
+ org-latex-default-table-environment))
+ ;; If table is a float, determine environment: table, table*
+ ;; or sidewaystable.
+ (float-env (unless (member table-env '("longtable" "longtabu"))
+ (let ((float (plist-get attr :float)))
+ (cond
+ ((and (not float) (plist-member attr :float)) nil)
+ ((string= float "sidewaystable") "sidewaystable")
+ ((string= float "multicolumn") "table*")
+ ((or float
+ (org-element-property :caption table)
+ (org-string-nw-p (plist-get attr :caption)))
+ "table")))))
+ ;; Extract others display options.
+ (fontsize (let ((font (plist-get attr :font)))
+ (and font (concat font "\n"))))
+ (width (plist-get attr :width))
+ (spreadp (plist-get attr :spread))
+ (placement (or (plist-get attr :placement)
+ (format "[%s]" org-latex-default-figure-position)))
+ (centerp (if (plist-member attr :center) (plist-get attr :center)
+ org-latex-tables-centered)))
+ ;; Prepare the final format string for the table.
+ (cond
+ ;; Longtable.
+ ((equal "longtable" table-env)
+ (concat (and fontsize (concat "{" fontsize))
+ (format "\\begin{longtable}{%s}\n" alignment)
+ (and org-latex-table-caption-above
+ (org-string-nw-p caption)
+ (concat caption "\\\\\n"))
+ contents
+ (and (not org-latex-table-caption-above)
+ (org-string-nw-p caption)
+ (concat caption "\\\\\n"))
+ "\\end{longtable}\n"
+ (and fontsize "}")))
+ ;; Longtabu
+ ((equal "longtabu" table-env)
+ (concat (and fontsize (concat "{" fontsize))
+ (format "\\begin{longtabu}%s{%s}\n"
+ (if width
+ (format " %s %s "
+ (if spreadp "spread" "to") width) "")
+ alignment)
+ (and org-latex-table-caption-above
+ (org-string-nw-p caption)
+ (concat caption "\\\\\n"))
+ contents
+ (and (not org-latex-table-caption-above)
+ (org-string-nw-p caption)
+ (concat caption "\\\\\n"))
+ "\\end{longtabu}\n"
+ (and fontsize "}")))
+ ;; Others.
+ (t (concat (cond
+ (float-env
+ (concat (format "\\begin{%s}%s\n" float-env placement)
+ (if org-latex-table-caption-above caption "")
+ (when centerp "\\centering\n")
+ fontsize))
+ (centerp (concat "\\begin{center}\n" fontsize))
+ (fontsize (concat "{" fontsize)))
+ (cond ((equal "tabu" table-env)
+ (format "\\begin{tabu}%s{%s}\n%s\\end{tabu}"
+ (if width (format
+ (if spreadp " spread %s " " to %s ")
+ width) "")
+ alignment
+ contents))
+ (t (format "\\begin{%s}%s{%s}\n%s\\end{%s}"
+ table-env
+ (if width (format "{%s}" width) "")
+ alignment
+ contents
+ table-env)))
+ (cond
+ (float-env
+ (concat (if org-latex-table-caption-above "" caption)
+ (format "\n\\end{%s}" float-env)))
+ (centerp "\n\\end{center}")
+ (fontsize "}")))))))
+
+(defun org-latex--table.el-table (table info)
+ "Return appropriate LaTeX code for a table.el table.
+
+TABLE is the table type element to transcode. INFO is a plist
+used as a communication channel.
+
+This function assumes TABLE has `table.el' as its `:type'
+property."
+ (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)))
+ (let ((attr (org-export-read-attribute :attr_latex table)))
+ (when (plist-get attr :rmlines)
+ ;; When the "rmlines" attribute is provided, remove all hlines
+ ;; but the the one separating heading from the table body.
+ (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))))))
+ (let ((centerp (if (plist-member attr :center) (plist-get attr :center)
+ org-latex-tables-centered)))
+ (if (not centerp) output
+ (format "\\begin{center}\n%s\n\\end{center}" output))))))
+
+(defun org-latex--math-table (table info)
+ "Return appropriate LaTeX code for a matrix.
+
+TABLE is the table type element to transcode. INFO is a plist
+used as a communication channel.
+
+This function assumes TABLE has `org' as its `:type' property and
+`inline-math' or `math' as its `:mode' attribute.."
+ (let* ((caption (org-latex--caption/label-string table info))
+ (attr (org-export-read-attribute :attr_latex table))
+ (inlinep (equal (plist-get attr :mode) "inline-math"))
+ (env (or (plist-get attr :environment)
+ org-latex-default-table-environment))
+ (contents
+ (mapconcat
+ (lambda (row)
+ ;; Ignore horizontal rules.
+ (when (eq (org-element-property :type row) 'standard)
+ ;; Return each cell unmodified.
+ (concat
+ (mapconcat
+ (lambda (cell)
+ (substring (org-element-interpret-data cell) 0 -1))
+ (org-element-map row 'table-cell 'identity info) "&")
+ (or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\")
+ "\n")))
+ (org-element-map table 'table-row 'identity info) ""))
+ ;; Variables related to math clusters (contiguous math tables
+ ;; of the same type).
+ (mode (org-export-read-attribute :attr_latex table :mode))
+ (prev (org-export-get-previous-element table info))
+ (next (org-export-get-next-element table info))
+ (same-mode-p
+ (lambda (table)
+ ;; Non-nil when TABLE has the same mode as current table.
+ (string= (or (org-export-read-attribute :attr_latex table :mode)
+ org-latex-default-table-mode)
+ mode))))
+ (concat
+ ;; Opening string. If TABLE is in the middle of a table cluster,
+ ;; do not insert any.
+ (cond ((and prev
+ (eq (org-element-type prev) 'table)
+ (memq (org-element-property :post-blank prev) '(0 nil))
+ (funcall same-mode-p prev))
+ nil)
+ (inlinep "\\(")
+ ((org-string-nw-p caption) (concat "\\begin{equation}\n" caption))
+ (t "\\["))
+ ;; Prefix.
+ (or (plist-get attr :math-prefix) "")
+ ;; Environment. Also treat special cases.
+ (cond ((equal env "array")
+ (let ((align (org-latex--align-string table info)))
+ (format "\\begin{array}{%s}\n%s\\end{array}" align contents)))
+ ((assoc env org-latex-table-matrix-macros)
+ (format "\\%s%s{\n%s}"
+ env
+ (or (plist-get attr :math-arguments) "")
+ contents))
+ (t (format "\\begin{%s}\n%s\\end{%s}" env contents env)))
+ ;; Suffix.
+ (or (plist-get attr :math-suffix) "")
+ ;; Closing string. If TABLE is in the middle of a table cluster,
+ ;; do not insert any. If it closes such a cluster, be sure to
+ ;; close the cluster with a string matching the opening string.
+ (cond ((and next
+ (eq (org-element-type next) 'table)
+ (memq (org-element-property :post-blank table) '(0 nil))
+ (funcall same-mode-p next))
+ nil)
+ (inlinep "\\)")
+ ;; Find cluster beginning to know which environment to use.
+ ((let ((cluster-beg table) prev)
+ (while (and (setq prev (org-export-get-previous-element
+ cluster-beg info))
+ (memq (org-element-property :post-blank prev)
+ '(0 nil))
+ (funcall same-mode-p prev))
+ (setq cluster-beg prev))
+ (and (or (org-element-property :caption cluster-beg)
+ (org-element-property :name cluster-beg))
+ "\n\\end{equation}")))
+ (t "\\]")))))
+
+
+;;;; Table Cell
+
+(defun org-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-latex-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-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-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 (org-export-read-attribute :attr_latex
+ (org-export-get-parent table-row)))
+ (longtablep (member (or (plist-get attr :environment)
+ org-latex-default-table-environment)
+ '("longtable" "longtabu")))
+ (booktabsp (if (plist-member attr :booktabs)
+ (plist-get attr :booktabs)
+ org-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-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-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-latex-plain-text
+ (org-timestamp-translate timestamp) info)))
+ (case (org-element-property :type timestamp)
+ ((active active-range) (format org-latex-active-timestamp-format value))
+ ((inactive inactive-range)
+ (format org-latex-inactive-timestamp-format value))
+ (otherwise (format org-latex-diary-timestamp-format value)))))
+
+
+;;;; Underline
+
+(defun org-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-latex--text-markup contents 'underline))
+
+
+;;;; Verbatim
+
+(defun org-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-latex--text-markup (org-element-property :value verbatim) 'verbatim))
+
+
+;;;; Verse Block
+
+(defun org-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-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))))
+
+
+
+;;; End-user functions
+
+;;;###autoload
+(defun org-latex-export-as-latex
+ (&optional async 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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+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 LATEX Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (org-export-to-buffer 'latex "*Org LATEX Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+
+;;;###autoload
+(defun org-latex-convert-region-to-latex ()
+ "Assume the current region has org-mode syntax, and convert it to LaTeX.
+This can be used in any buffer. For example, you can write an
+itemized list in org-mode syntax in an LaTeX buffer and use this
+command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'latex))
+
+;;;###autoload
+(defun org-latex-export-to-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'latex outfile
+ async subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-latex-export-to-pdf
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return PDF file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'latex outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
+
+(defun org-latex-compile (texfile &optional snippet)
+ "Compile a TeX file.
+
+TEXFILE is the name of the file being compiled. Processing is
+done through the command specified in `org-latex-pdf-process'.
+
+When optional argument SNIPPET is non-nil, TEXFILE is a temporary
+file used to preview a LaTeX snippet. In this case, do not
+create a log buffer and do not bother removing log files.
+
+Return PDF file name or an error if it couldn't be produced."
+ (let* ((base-name (file-name-sans-extension (file-name-nondirectory texfile)))
+ (full-name (file-truename texfile))
+ (out-dir (file-name-directory texfile))
+ ;; Properly set working directory for compilation.
+ (default-directory (if (file-name-absolute-p texfile)
+ (file-name-directory full-name)
+ default-directory))
+ errors)
+ (unless snippet (message (format "Processing LaTeX file %s..." texfile)))
+ (save-window-excursion
+ (cond
+ ;; A function is provided: Apply it.
+ ((functionp org-latex-pdf-process)
+ (funcall org-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-latex-pdf-process)
+ (let ((outbuf (and (not snippet)
+ (get-buffer-create "*Org PDF LaTeX Output*"))))
+ (mapc
+ (lambda (command)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base-name)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument full-name)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
+ org-latex-pdf-process)
+ ;; Collect standard errors from output buffer.
+ (setq errors (and (not snippet) (org-latex--collect-errors outbuf)))))
+ (t (error "No valid command to process to PDF")))
+ (let ((pdffile (concat out-dir base-name ".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 (and (not snippet) org-latex-remove-logfiles)
+ (dolist (file (directory-files
+ out-dir t
+ (concat (regexp-quote base-name)
+ "\\(?:\\.[0-9]+\\)?"
+ "\\."
+ (regexp-opt org-latex-logfiles-extensions))))
+ (delete-file file)))
+ (message (concat "Process completed"
+ (if (not errors) "."
+ (concat " with errors: " errors)))))
+ ;; Return output file name.
+ pdffile))))
+
+(defun org-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))
+ (when (re-search-backward "^[ \t]*This is .*?TeX.*?Version" nil t)
+ (let ((case-fold-search t)
+ (errors ""))
+ (dolist (latex-error org-latex-known-errors)
+ (when (save-excursion (re-search-forward (car latex-error) nil t))
+ (setq errors (concat errors " " (cdr latex-error)))))
+ (and (org-string-nw-p errors) (org-trim errors)))))))
+
+;;;###autoload
+(defun org-latex-publish-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-publish-org-to 'latex filename ".tex" plist pub-dir))
+
+;;;###autoload
+(defun org-latex-publish-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."
+ ;; Unlike to `org-latex-publish-to-latex', PDF file is generated
+ ;; in working directory and then moved to publishing directory.
+ (org-publish-attachment
+ plist
+ (org-latex-compile (org-publish-org-to 'latex filename ".tex" plist))
+ pub-dir))
+
+
+(provide 'ox-latex)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-latex.el ends here
diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el
new file mode 100644
index 0000000000..a160e4cff4
--- /dev/null
+++ b/lisp/org/ox-man.el
@@ -0,0 +1,1260 @@
+;; ox-man.el --- Man Back-End for Org Export Engine
+
+;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Luis R Anaya <papoanaya aroba hot mail punto 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 library implements a Man back-end for Org generic exporter.
+;;
+;; To test it, run
+;;
+;; M-: (org-export-to-buffer 'man "*Test Man*") RET
+;;
+;; in an org-mode buffer then switch to the buffer to see the Man
+;; export. See ox.el for more details on how this exporter works.
+;;
+;; It introduces one new buffer keywords:
+;; "MAN_CLASS_OPTIONS".
+
+;;; Code:
+
+(require 'ox)
+
+(eval-when-compile (require 'cl))
+
+(defvar org-export-man-default-packages-alist)
+(defvar org-export-man-packages-alist)
+(defvar orgtbl-exp-regexp)
+
+
+
+;;; Define Back-End
+
+(org-export-define-backend 'man
+ '((babel-call . org-man-babel-call)
+ (bold . org-man-bold)
+ (center-block . org-man-center-block)
+ (clock . org-man-clock)
+ (code . org-man-code)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (drawer . org-man-drawer)
+ (dynamic-block . org-man-dynamic-block)
+ (entity . org-man-entity)
+ (example-block . org-man-example-block)
+ (export-block . org-man-export-block)
+ (export-snippet . org-man-export-snippet)
+ (fixed-width . org-man-fixed-width)
+ (footnote-definition . org-man-footnote-definition)
+ (footnote-reference . org-man-footnote-reference)
+ (headline . org-man-headline)
+ (horizontal-rule . org-man-horizontal-rule)
+ (inline-babel-call . org-man-inline-babel-call)
+ (inline-src-block . org-man-inline-src-block)
+ (inlinetask . org-man-inlinetask)
+ (italic . org-man-italic)
+ (item . org-man-item)
+ (keyword . org-man-keyword)
+ (line-break . org-man-line-break)
+ (link . org-man-link)
+ (paragraph . org-man-paragraph)
+ (plain-list . org-man-plain-list)
+ (plain-text . org-man-plain-text)
+ (planning . org-man-planning)
+ (property-drawer . (lambda (&rest args) ""))
+ (quote-block . org-man-quote-block)
+ (quote-section . org-man-quote-section)
+ (radio-target . org-man-radio-target)
+ (section . org-man-section)
+ (special-block . org-man-special-block)
+ (src-block . org-man-src-block)
+ (statistics-cookie . org-man-statistics-cookie)
+ (strike-through . org-man-strike-through)
+ (subscript . org-man-subscript)
+ (superscript . org-man-superscript)
+ (table . org-man-table)
+ (table-cell . org-man-table-cell)
+ (table-row . org-man-table-row)
+ (target . org-man-target)
+ (template . org-man-template)
+ (timestamp . org-man-timestamp)
+ (underline . org-man-underline)
+ (verbatim . org-man-verbatim)
+ (verse-block . org-man-verse-block))
+ :export-block "MAN"
+ :menu-entry
+ '(?m "Export to MAN"
+ ((?m "As MAN file" org-man-export-to-man)
+ (?p "As PDF file" org-man-export-to-pdf)
+ (?o "As PDF file and open"
+ (lambda (a s v b)
+ (if a (org-man-export-to-pdf t s v b)
+ (org-open-file (org-man-export-to-pdf nil s v b)))))))
+ :options-alist
+ '((:man-class "MAN_CLASS" nil nil t)
+ (:man-class-options "MAN_CLASS_OPTIONS" nil nil t)
+ (:man-header-extra "MAN_HEADER" nil nil newline)))
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-man nil
+ "Options for exporting Org mode files to Man."
+ :tag "Org Export Man"
+ :group 'org-export)
+
+;;; Tables
+
+(defcustom org-man-tables-centered t
+ "When non-nil, tables are exported in a center environment."
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-man-tables-verbatim nil
+ "When non-nil, tables are exported verbatim."
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+
+(defcustom org-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-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting")))
+
+
+;;; Inlinetasks
+;; Src blocks
+
+(defcustom org-man-source-highlight nil
+ "Use GNU source highlight to embellish source blocks "
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+
+(defcustom org-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-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Listings language"))))
+
+
+
+(defvar org-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-man-custom-lang-environments
+ '\(\(python \"pythoncode\"\)\)\)
+
+would have the effect that if org encounters begin_src python
+during man export."
+)
+
+
+;;; Compilation
+
+(defcustom org-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 directory
+and extension parts) 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
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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-man-logfiles-extensions
+ '("log" "out" "toc")
+ "The list of file extensions to consider as Man logfiles."
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-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-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+
+
+;;; Internal Functions
+
+(defun org-man--caption/label-string (element info)
+ "Return caption and label Man string for ELEMENT.
+
+INFO is a plist holding contextual information. If there's no
+caption nor label, return the empty string.
+
+For non-floats, see `org-man--wrap-label'."
+ (let ((label (org-element-property :label element))
+ (main (org-export-get-caption element))
+ (short (org-export-get-caption element t)))
+ (cond ((and (not main) (not label)) "")
+ ((not main) (format "\\fI%s\\fP" label))
+ ;; Option caption format with short name.
+ (short (format "\\fR%s\\fP - \\fI\\P - %s\n"
+ (org-export-data short info)
+ (org-export-data main info)))
+ ;; Standard caption format.
+ (t (format "\\fR%s\\fP" (org-export-data main info))))))
+
+(defun org-man--wrap-label (element output)
+ "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
+This function shouldn't be used for floats. See
+`org-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-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-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-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-man--wrap-label
+ center-block
+ (format ".ce %d\n.nf\n%s\n.fi"
+ (- (length (split-string contents "\n")) 1 )
+ contents)))
+
+
+;;; Clock
+
+(defun org-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-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-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-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-man--wrap-label dynamic-block contents))
+
+
+;;; Entity
+
+(defun org-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."
+ (org-element-property :utf-8 entity))
+
+
+;;; Example Block
+
+(defun org-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-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-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-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) 'man)
+ (org-element-property :value export-snippet)))
+
+
+;;; Fixed Width
+
+(defun org-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-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-man-headline (headline contents info)
+ "Transcode a 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-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-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-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-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-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-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)
+ ((string= key "TOC" ) nil))))
+
+
+;;; Line Break
+
+(defun org-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-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)))))
+
+
+;;; Paragraph
+
+(defun org-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-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-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."
+ (let ((output text))
+ ;; Protect various chars.
+ (setq output (replace-regexp-in-string
+ "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
+ "$\\" output nil t 1))
+ ;; Activate smart quotes. Be sure to provide original TEXT string
+ ;; since OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output (org-export-activate-smart-quotes output :utf-8 info text)))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n"
+ output)))
+ ;; Return value.
+ output))
+
+
+
+;;; Planning
+
+
+;;; Property Drawer
+
+
+;;; Quote Block
+
+(defun org-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-man--wrap-label
+ quote-block
+ (format ".RS\n%s\n.RE" contents)))
+
+;;; Quote Section
+
+(defun org-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-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-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-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-man--wrap-label
+ special-block
+ (format "%s\n" contents))))
+
+
+;;; Src Block
+
+(defun org-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))
+ (code (org-element-property :value src-block))
+ (custom-env (and lang
+ (cadr (assq (intern lang)
+ org-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-man-source-highlight)
+ (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
+ (org-export-format-code-default src-block info)))
+ (org-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-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-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-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-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-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-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-man-table--table.el-table' or
+;; `org-man-table--org-table' functions, depending of the type of
+;; the table.
+;;
+;; `org-man-table--align-string' is a subroutine used to build
+;; alignment string for Org tables.
+
+(defun org-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-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-man-table--org-table table contents info))))
+
+(defun org-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-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* ((attr (org-export-read-attribute :attr_man table))
+ (label (org-element-property :name table))
+ (caption (and (not (plist-get attr :disable-caption))
+ (org-man--caption/label-string table info)))
+ (divider (if (plist-get attr :divider) "|" " "))
+
+ ;; Determine alignment string.
+ (alignment (org-man-table--align-string divider table info))
+ ;; Extract others display options.
+
+ (lines (org-split-string contents "\n"))
+
+ (attr-list
+ (delq nil
+ (list
+ (and (plist-get attr :expand) "expand")
+ (let ((placement (plist-get attr :placement)))
+ (cond ((string= placement 'center) "center")
+ ((string= placement 'left) nil)
+ (t (if org-man-tables-centered "center" ""))))
+ (or (plist-get attr :boxtype) "box"))))
+
+ (title-line (plist-get attr :title-line))
+ (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.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))
+
+ (and caption (format ".TB \"%s\"" caption)))))))
+
+;;; Table Cell
+
+(defun org-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-man-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-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-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 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-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-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-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-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-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-man-export-to-man
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".man" subtreep)))
+ (org-export-to-file 'man outfile
+ async subtreep visible-only body-only ext-plist)))
+
+(defun org-man-export-to-pdf
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return PDF file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".man" subtreep)))
+ (org-export-to-file 'man outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
+
+(defun org-man-compile (file)
+ "Compile a Groff file.
+
+FILE is the name of the file being compiled. Processing is done
+through the command specified in `org-man-pdf-process'.
+
+Return PDF file name or an error if it couldn't be produced."
+ (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
+ (full-name (file-truename file))
+ (out-dir (file-name-directory file))
+ ;; Properly set working directory for compilation.
+ (default-directory (if (file-name-absolute-p file)
+ (file-name-directory full-name)
+ default-directory))
+ errors)
+ (message (format "Processing Groff file %s..." file))
+ (save-window-excursion
+ (cond
+ ;; A function is provided: Apply it.
+ ((functionp org-man-pdf-process)
+ (funcall org-man-pdf-process (shell-quote-argument file)))
+ ;; 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-man-pdf-process)
+ (let ((outbuf (get-buffer-create "*Org PDF Groff Output*")))
+ (mapc
+ (lambda (command)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base-name)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument full-name)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
+ org-man-pdf-process)
+ ;; Collect standard errors from output buffer.
+ (setq errors (org-man-collect-errors outbuf))))
+ (t (error "No valid command to process to PDF")))
+ (let ((pdffile (concat out-dir base-name ".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-man-remove-logfiles
+ (dolist (ext org-man-logfiles-extensions)
+ (let ((file (concat out-dir base-name "." 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))))
+
+(defun org-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 'ox-man)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-man.el ends here
diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el
new file mode 100644
index 0000000000..7d540787d9
--- /dev/null
+++ b/lisp/org/ox-md.el
@@ -0,0 +1,483 @@
+;;; ox-md.el --- Markdown Back-End for Org Export Engine
+
+;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <[email protected]>
+;; Keywords: org, wp, markdown
+
+;; 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 Markdown back-end (vanilla flavour) for
+;; Org exporter, based on `html' back-end. See Org manual for more
+;; information.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox-html)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-md nil
+ "Options specific to Markdown export back-end."
+ :tag "Org Markdown"
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(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 'html
+ :export-block '("MD" "MARKDOWN")
+ :filters-alist '((:filter-parse-tree . org-md-separate-elements))
+ :menu-entry
+ '(?m "Export to Markdown"
+ ((?M "To temporary buffer"
+ (lambda (a s v b) (org-md-export-as-markdown a s v)))
+ (?m "To file" (lambda (a s v b) (org-md-export-to-markdown a s v)))
+ (?o "To file and open"
+ (lambda (a s v b)
+ (if a (org-md-export-to-markdown t s v)
+ (org-open-file (org-md-export-to-markdown nil s v)))))))
+ :translate-alist '((bold . org-md-bold)
+ (code . org-md-verbatim)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (example-block . org-md-example-block)
+ (fixed-width . 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 a 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."
+ " \n")
+
+
+;;;; 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-html-link-org-files-as-html'.
+ (cond
+ ((and org-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-html-inline-image-rules)
+ (let ((path (let ((raw-path (org-element-property :path link)))
+ (if (not (file-name-absolute-p raw-path)) raw-path
+ (expand-file-name raw-path)))))
+ (format "![%s](%s)"
+ (let ((caption (org-export-get-caption
+ (org-export-get-parent-element link))))
+ (when caption (org-export-data 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)))
+ (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")
+ ;; 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."
+ (when (plist-get info :with-smart-quotes)
+ (setq text (org-export-activate-smart-quotes text :html info)))
+ ;; 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 "[`*_\\]" "\\\\\\&" text))
+ ;; Handle special strings, if required.
+ (when (plist-get info :with-special-strings)
+ (setq text (org-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 async subtreep visible-only)
+ "Export current buffer to a Markdown buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+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)
+ (org-export-to-buffer 'md "*Org MD Export*"
+ async subtreep visible-only nil nil (lambda () (text-mode))))
+
+;;;###autoload
+(defun org-md-convert-region-to-md ()
+ "Assume the current region has org-mode syntax, and convert it to Markdown.
+This can be used in any buffer. For example, you can write an
+itemized list in org-mode syntax in a Markdown buffer and use
+this command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'md))
+
+
+;;;###autoload
+(defun org-md-export-to-markdown (&optional async subtreep visible-only)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".md" subtreep)))
+ (org-export-to-file 'md outfile async subtreep visible-only)))
+
+
+(provide 'ox-md)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-md.el ends here
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
new file mode 100644
index 0000000000..07f6889ae9
--- /dev/null
+++ b/lisp/org/ox-odt.el
@@ -0,0 +1,4413 @@
+;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode
+
+;; Copyright (C) 2010-2013 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 'table nil 'noerror))
+(require 'format-spec)
+(require 'ox)
+(require 'org-compat)
+
+;;; Define Back-End
+
+(org-export-define-backend 'odt
+ '((bold . org-odt-bold)
+ (center-block . org-odt-center-block)
+ (clock . org-odt-clock)
+ (code . org-odt-code)
+ (drawer . org-odt-drawer)
+ (dynamic-block . org-odt-dynamic-block)
+ (entity . org-odt-entity)
+ (example-block . org-odt-example-block)
+ (export-block . org-odt-export-block)
+ (export-snippet . org-odt-export-snippet)
+ (fixed-width . org-odt-fixed-width)
+ (footnote-definition . org-odt-footnote-definition)
+ (footnote-reference . org-odt-footnote-reference)
+ (headline . org-odt-headline)
+ (horizontal-rule . org-odt-horizontal-rule)
+ (inline-src-block . org-odt-inline-src-block)
+ (inlinetask . org-odt-inlinetask)
+ (italic . org-odt-italic)
+ (item . org-odt-item)
+ (keyword . org-odt-keyword)
+ (latex-environment . org-odt-latex-environment)
+ (latex-fragment . org-odt-latex-fragment)
+ (line-break . org-odt-line-break)
+ (link . org-odt-link)
+ (paragraph . org-odt-paragraph)
+ (plain-list . org-odt-plain-list)
+ (plain-text . org-odt-plain-text)
+ (planning . org-odt-planning)
+ (property-drawer . org-odt-property-drawer)
+ (quote-block . org-odt-quote-block)
+ (quote-section . org-odt-quote-section)
+ (radio-target . org-odt-radio-target)
+ (section . org-odt-section)
+ (special-block . org-odt-special-block)
+ (src-block . org-odt-src-block)
+ (statistics-cookie . org-odt-statistics-cookie)
+ (strike-through . org-odt-strike-through)
+ (subscript . org-odt-subscript)
+ (superscript . org-odt-superscript)
+ (table . org-odt-table)
+ (table-cell . org-odt-table-cell)
+ (table-row . org-odt-table-row)
+ (target . org-odt-target)
+ (template . org-odt-template)
+ (timestamp . org-odt-timestamp)
+ (underline . org-odt-underline)
+ (verbatim . org-odt-verbatim)
+ (verse-block . org-odt-verse-block))
+ :export-block "ODT"
+ :filters-alist '((:filter-parse-tree
+ . (org-odt--translate-latex-fragments
+ org-odt--translate-description-lists
+ org-odt--translate-list-tables)))
+ :menu-entry
+ '(?o "Export to ODT"
+ ((?o "As ODT file" org-odt-export-to-odt)
+ (?O "As ODT file and open"
+ (lambda (a s v b)
+ (if a (org-odt-export-to-odt t s v)
+ (org-open-file (org-odt-export-to-odt nil s v) 'system))))))
+ :options-alist
+ '((:odt-styles-file "ODT_STYLES_FILE" nil nil t)
+ ;; Redefine regular option.
+ (:with-latex nil "tex" org-odt-with-latex)))
+
+
+;;; 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" (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-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-odt-schema-dir'.")
+
+(defvar org-odt-data-dir
+ (expand-file-name "../../etc/" org-odt-lib-dir)
+ "Data directory for ODT exporter.
+Use this to infer values of `org-odt-styles-dir' and
+`org-odt-schema-dir'.")
+
+(defconst org-odt-special-string-regexps
+ '(("\\\\-" . "&#x00ad;\\1") ; shy
+ ("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
+ ("--\\([^-]\\)" . "&#x2013;\\1") ; ndash
+ ("\\.\\.\\." . "&#x2026;")) ; hellip
+ "Regular expressions for special string conversion.")
+
+(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-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'.")
+
+(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 (ox-odt): Searching for OpenDocument styles files...")
+ (mapc (lambda (styles-dir)
+ (when styles-dir
+ (message "Debug (ox-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 (ox-odt): Using styles under %s"
+ styles-dir)
+ (throw 'styles-dir styles-dir))))
+ org-odt-styles-dir-list)
+ nil)))
+ (unless styles-dir
+ (error "Error (ox-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-odt-styles-file' and
+ `org-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.")
+
+(defconst org-odt-bookmark-prefix "OrgXref.")
+
+(defconst org-odt-manifest-file-entry-tag
+ "\n<manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"%s/>")
+
+(defconst 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")))
+
+(defconst org-odt-table-style-format
+ "
+<style:style style:name=\"%s\" style:family=\"table\">
+ <style:table-properties style:rel-width=\"%s%%\" 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-odt-parse-block-attributes'.
+
+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'.")
+
+(defvar org-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-odt-embedded-formulas-count 0)
+(defvar org-odt-embedded-images-count 0)
+(defvar org-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-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-odt-max-image-size '(17.0 . 20.0)
+ "Limiting dimensions for an embedded image.")
+
+(defconst 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:
+
+ \(STYLE-NAME ATTACH-FMT REF-MODE REF-FMT)
+
+ATTACH-FMT controls how labels and captions are attached to an
+entity. It may contain following specifiers - %e and %c. %e is
+replaced with the CATEGORY-NAME. %n is replaced with
+\"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced
+with CAPTION.
+
+REF-MODE and REF-FMT controls how label references are generated.
+The following XML is generated for a label reference -
+\"<text:sequence-ref text:reference-format=\"REF-MODE\" ...>
+REF-FMT </text:sequence-ref>\". REF-FMT may contain following
+specifiers - %e and %n. %e is replaced with the CATEGORY-NAME.
+%n is replaced with SEQNO.
+
+See also `org-odt-format-label'.")
+
+(defvar org-odt-category-map-alist
+ '(("__Table__" "Table" "value" "Table" org-odt--enumerable-p)
+ ("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p)
+ ("__MathFormula__" "Text" "math-formula" "Equation" org-odt--enumerable-formula-p)
+ ("__DvipngImage__" "Equation" "value" "Equation" org-odt--enumerable-latex-image-p)
+ ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p))
+ "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 ENUMERATOR-PREDICATE)
+
+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-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.
+
+CATEGORY-NAME is used for qualifying captions on export.
+
+ENUMERATOR-PREDICATE is used for assigning a sequence number to
+the entity. See `org-odt--enumerate'.")
+
+(defvar org-odt-manifest-file-entries nil)
+(defvar hfy-user-sheet-assoc)
+
+(defvar org-odt-zip-dir nil
+ "Temporary work directory for OpenDocument exporter.")
+
+
+
+;;; User Configuration Variables
+
+(defgroup org-export-odt nil
+ "Options for exporting Org mode files to ODT."
+ :tag "Org Export ODT"
+ :group 'org-export)
+
+
+;;;; Debugging
+
+(defcustom org-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)
+
+
+;;;; Document schema
+
+(require 'rng-loc)
+(defcustom org-odt-schema-dir
+ (let* ((schema-dir
+ (catch 'schema-dir
+ (message "Debug (ox-odt): Searching for OpenDocument schema files...")
+ (mapc
+ (lambda (schema-dir)
+ (when schema-dir
+ (message "Debug (ox-odt): Trying %s..." schema-dir)
+ (when (and (file-expand-wildcards
+ (expand-file-name "od-manifest-schema*.rnc"
+ schema-dir))
+ (file-expand-wildcards
+ (expand-file-name "od-schema*.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ (message "Debug (ox-odt): Using schema files under %s"
+ schema-dir)
+ (throw 'schema-dir schema-dir))))
+ org-odt-schema-dir-list)
+ (message "Debug (ox-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-odt-schema-dir'.
+Also add it to `rng-schema-locating-files'."
+ (let ((schema-dir value))
+ (set var
+ (if (and
+ (file-expand-wildcards
+ (expand-file-name "od-manifest-schema*.rnc" schema-dir))
+ (file-expand-wildcards
+ (expand-file-name "od-schema*.rnc" schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ schema-dir
+ (when value
+ (message "Error (ox-odt): %s has no OpenDocument schema files"
+ value))
+ nil)))
+ (when org-odt-schema-dir
+ (eval-after-load 'rng-loc
+ '(add-to-list 'rng-schema-locating-files
+ (expand-file-name "schemas.xml"
+ org-odt-schema-dir))))))
+
+
+;;;; Document styles
+
+(defcustom org-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 '(choice (const nil)
+ (file))
+ :group 'org-export-odt
+ :version "24.1")
+
+(defcustom org-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"))))))
+
+(defcustom org-odt-display-outline-level 2
+ "Outline levels considered for enumerating captioned entities."
+ :group 'org-export-odt
+ :version "24.2"
+ :type 'integer)
+
+;;;; Document conversion
+
+(defcustom org-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-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-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-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-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-odt-convert-processes))))
+
+(defcustom org-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-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-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-odt-convert' commands.
+- It is used as the value of \"%f\" specifier in
+ `org-odt-convert-process'.
+
+EXTRA-OPTIONS is used as the value of \"%x\" specifier in
+`org-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"))))))))
+
+(defcustom org-odt-preferred-output-format nil
+ "Automatically post-process to this format after exporting to \"odt\".
+Command `org-odt-export-to-odt' exports first to \"odt\" format
+and then uses `org-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-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-odt-reachable-formats "odt")))))
+;;;###autoload
+(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp)
+
+
+;;;; Drawers
+
+(defcustom org-odt-format-drawer-function nil
+ "Function called to format a drawer in ODT 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-odt-format-drawer-default \(name contents\)
+ \"Format a drawer element for ODT export.\"
+ contents\)"
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+;;;; Headline
+
+(defcustom org-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 as headline text."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+;;;; Inlinetasks
+
+(defcustom org-odt-format-inlinetask-function nil
+ "Function called to format an inlinetask in ODT 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."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+;;;; LaTeX
+
+(defcustom org-odt-with-latex org-export-with-latex
+ "Non-nil means process LaTeX math snippets.
+
+When set, the exporter will process LaTeX environments and
+fragments.
+
+This option can also be set with the +OPTIONS line,
+e.g. \"tex:mathjax\". Allowed values are:
+
+nil Ignore math snippets.
+`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.
+`mathjax' Do MathJax preprocessing and arrange for MathJax.js to
+ be loaded.
+t Synonym for `mathjax'."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not process math in any way" nil)
+ (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)))
+
+
+;;;; Links
+
+(defcustom org-odt-inline-formula-rules
+ '(("file" . "\\.\\(mathml\\|mml\\|odf\\)\\'"))
+ "Rules characterizing formula files that can be inlined into ODT.
+
+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."
+ :group 'org-export-odt
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+(defcustom org-odt-inline-image-rules
+ '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'"))
+ "Rules characterizing image files that can be inlined into ODT.
+
+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."
+ :group 'org-export-odt
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+(defcustom org-odt-pixels-per-inch 96.0
+ "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.4"
+ :package-version '(Org . "8.1"))
+
+
+;;;; Src Block
+
+(defcustom org-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-odt-fontify-srcblocks' is turned on."
+ :group 'org-export-odt
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-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")
+
+
+;;;; Table
+
+(defcustom org-odt-table-styles
+ '(("OrgEquation" "OrgEquation"
+ ((use-first-column-styles . t)
+ (use-last-column-styles . t)))
+ ("TableWithHeaderRowAndColumn" "Custom"
+ ((use-first-row-styles . t)
+ (use-first-column-styles . t)))
+ ("TableWithFirstRowandLastRow" "Custom"
+ ((use-first-row-styles . t)
+ (use-last-row-styles . t)))
+ ("GriddedTable" "Custom" nil))
+ "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-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-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))))))
+
+;;;; Timestamps
+
+(defcustom org-odt-use-date-fields nil
+ "Non-nil, if timestamps should be exported as date fields.
+
+When nil, export timestamps as plain text.
+
+When non-nil, map `org-time-stamp-custom-formats' to a pair of
+OpenDocument date-styles with names \"OrgDate1\" and \"OrgDate2\"
+respectively. A timestamp with no time component is formatted
+with style \"OrgDate1\" while one with explicit hour and minutes
+is formatted with style \"OrgDate2\".
+
+This feature is experimental. Most (but not all) of the common
+%-specifiers in `format-time-string' are supported.
+Specifically, locale-dependent specifiers like \"%c\", \"%x\" are
+formatted as canonical Org timestamps. For finer control, avoid
+these %-specifiers.
+
+Textutal specifiers like \"%b\", \"%h\", \"%B\", \"%a\", \"%A\"
+etc., are displayed by the application in the default language
+and country specified in `org-odt-styles-file'. Note that the
+default styles file uses language \"en\" and country \"GB\". You
+can localize the week day and month strings in the exported
+document by setting the default language and country either using
+the application UI or through a custom styles file.
+
+See `org-odt--build-date-styles' for implementation details."
+ :group 'org-export-odt
+ :type 'boolean)
+
+
+
+;;; Internal functions
+
+;;;; Date
+
+(defun org-odt--format-timestamp (timestamp &optional end iso-date-p)
+ (let* ((format-timestamp
+ (lambda (timestamp format &optional end utc)
+ (if timestamp
+ (org-timestamp-format timestamp format end utc)
+ (format-time-string format nil utc))))
+ (has-time-p (or (not timestamp)
+ (org-timestamp-has-time-p timestamp)))
+ (iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S"
+ "%Y-%m-%dT%H:%M:%S")))
+ (funcall format-timestamp timestamp format end))))
+ (if iso-date-p iso-date
+ (let* ((style (if has-time-p "OrgDate2" "OrgDate1"))
+ ;; LibreOffice does not care about end goes as content
+ ;; within the "<text:date>...</text:date>" field. The
+ ;; displayed date is automagically corrected to match the
+ ;; format requested by "style:data-style-name" attribute. So
+ ;; don't bother about formatting the date contents to be
+ ;; compatible with "OrgDate1" and "OrgDateTime" styles. A
+ ;; simple Org-style date should suffice.
+ (date (let* ((formats
+ (if org-display-custom-times
+ (cons (substring
+ (car org-time-stamp-custom-formats) 1 -1)
+ (substring
+ (cdr org-time-stamp-custom-formats) 1 -1))
+ '("%Y-%m-%d %a" . "%Y-%m-%d %a %H:%M")))
+ (format (if has-time-p (cdr formats) (car formats))))
+ (funcall format-timestamp timestamp format end)))
+ (repeater (let ((repeater-type (org-element-property
+ :repeater-type timestamp))
+ (repeater-value (org-element-property
+ :repeater-value timestamp))
+ (repeater-unit (org-element-property
+ :repeater-unit timestamp)))
+ (concat
+ (case repeater-type
+ (catchup "++") (restart ".+") (cumulate "+"))
+ (when repeater-value
+ (number-to-string repeater-value))
+ (case repeater-unit
+ (hour "h") (day "d") (week "w") (month "m")
+ (year "y"))))))
+ (concat
+ (format "<text:date text:date-value=\"%s\" style:data-style-name=\"%s\" text:fixed=\"true\">%s</text:date>"
+ iso-date style date)
+ (and (not (string= repeater "")) " ")
+ repeater)))))
+
+;;;; Frame
+
+(defun org-odt--frame (text width height style &optional extra
+ anchor-type &rest title-and-desc)
+ (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 (car title-and-desc))
+ (desc (cadr title-and-desc)))
+ (concat (when title
+ (format "<svg:title>%s</svg:title>"
+ (org-odt--encode-plain-text title t)))
+ (when desc
+ (format "<svg:desc>%s</svg:desc>"
+ (org-odt--encode-plain-text desc t)))))))))
+
+
+;;;; Library wrappers
+
+(defun org-odt--zip-extract (archive members target)
+ (when (atom members) (setq members (list members)))
+ (mapc (lambda (member)
+ (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))
+
+;;;; Target
+
+(defun org-odt--target (text id)
+ (if (not id) text
+ (concat
+ (format "\n<text:bookmark-start text:name=\"OrgXref.%s\"/>" id)
+ (format "\n<text:bookmark text:name=\"%s\"/>" id) text
+ (format "\n<text:bookmark-end text:name=\"OrgXref.%s\"/>" id))))
+
+;;;; Textbox
+
+(defun org-odt--textbox (text width height style &optional
+ extra anchor-type)
+ (org-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-odt-begin-toc (index-title depth)
+ (concat
+ (format "
+ <text:table-of-content text:style-name=\"OrgIndexSection\" text:protected=\"true\" text:name=\"Table of Contents\">
+ <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-odt-end-toc ()
+ (format "
+ </text:index-body>
+ </text:table-of-content>
+"))
+
+(defun* org-odt-format-toc-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ (setq text
+ (concat
+ ;; Section number.
+ (when section-number (concat section-number ". "))
+ ;; Todo.
+ (when todo
+ (let ((style (if (member todo org-done-keywords)
+ "OrgDone" "OrgTodo")))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style todo)))
+ (when priority
+ (let* ((style (format "OrgPriority-%s" priority))
+ (priority (format "[#%c]" priority)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style priority)))
+ ;; Title.
+ text
+ ;; Tags.
+ (when tags
+ (concat
+ (format " <text:span text:style-name=\"%s\">[%s]</text:span>"
+ "OrgTags"
+ (mapconcat
+ (lambda (tag)
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTag" tag)) tags " : "))))))
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ headline-label text))
+
+(defun org-odt-toc (depth info)
+ (assert (wholenump depth))
+ ;; When a headline is marked as a radio target, as in the example below:
+ ;;
+ ;; ** <<<Some Heading>>>
+ ;; Some text.
+ ;;
+ ;; suppress generation of radio targets. i.e., Radio targets are to
+ ;; be marked as targets within /document body/ and *not* within
+ ;; /TOC/, as otherwise there will be duplicated anchors one in TOC
+ ;; and one in the document body.
+ ;;
+ ;; FIXME-1: Currently exported headings are memoized. `org-export.el'
+ ;; doesn't provide a way to disable memoization. So this doesn't
+ ;; work.
+ ;;
+ ;; FIXME-2: Are there any other objects that need to be suppressed
+ ;; within TOC?
+ (let* ((title (org-export-translate "Table of Contents" :utf-8 info))
+ (headlines (org-export-collect-headlines
+ info (and (wholenump depth) depth)))
+ (backend (org-export-create-backend
+ :parent (org-export-backend-name
+ (plist-get info :back-end))
+ :transcoders (mapcar
+ (lambda (type) (cons type (lambda (d c i) c)))
+ (list 'radio-target)))))
+ (when headlines
+ (concat
+ (org-odt-begin-toc title depth)
+ (mapconcat
+ (lambda (headline)
+ (let* ((entry (org-odt-format-headline--wrap
+ headline backend info 'org-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-odt-end-toc)))))
+
+
+;;;; Document styles
+
+(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-odt-parse-block-attributes'.
+
+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)))
+
+;;;; Checkbox
+
+(defun org-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-odt--build-date-styles (fmt style)
+ ;; In LibreOffice 3.4.6, there doesn't seem to be a convenient way
+ ;; to modify the date fields. A date could be modified by
+ ;; offsetting in days. That's about it. Also, date and time may
+ ;; have to be emitted as two fields - a date field and a time field
+ ;; - separately.
+
+ ;; One can add Form Controls to date and time fields so that they
+ ;; can be easily modified. But then, the exported document will
+ ;; become tightly coupled with LibreOffice and may not function
+ ;; properly with other OpenDocument applications.
+
+ ;; I have a strange feeling that Date styles are a bit flaky at the
+ ;; moment.
+
+ ;; The feature is experimental.
+ (when (and fmt style)
+ (let* ((fmt-alist
+ '(("%A" . "<number:day-of-week number:style=\"long\"/>")
+ ("%B" . "<number:month number:textual=\"true\" number:style=\"long\"/>")
+ ("%H" . "<number:hours number:style=\"long\"/>")
+ ("%M" . "<number:minutes number:style=\"long\"/>")
+ ("%S" . "<number:seconds number:style=\"long\"/>")
+ ("%V" . "<number:week-of-year/>")
+ ("%Y" . "<number:year number:style=\"long\"/>")
+ ("%a" . "<number:day-of-week number:style=\"short\"/>")
+ ("%b" . "<number:month number:textual=\"true\" number:style=\"short\"/>")
+ ("%d" . "<number:day number:style=\"long\"/>")
+ ("%e" . "<number:day number:style=\"short\"/>")
+ ("%h" . "<number:month number:textual=\"true\" number:style=\"short\"/>")
+ ("%k" . "<number:hours number:style=\"short\"/>")
+ ("%m" . "<number:month number:style=\"long\"/>")
+ ("%p" . "<number:am-pm/>")
+ ("%y" . "<number:year number:style=\"short\"/>")))
+ (case-fold-search nil)
+ (re (mapconcat 'identity (mapcar 'car fmt-alist) "\\|"))
+ match rpl (start 0) (filler-beg 0) filler-end filler output)
+ (mapc
+ (lambda (pair)
+ (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t)))
+ '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns
+ ("%C" . "Y") ; replace century with year
+ ("%D" . "%m/%d/%y")
+ ("%G" . "Y") ; year corresponding to iso week
+ ("%I" . "%H") ; hour on a 12-hour clock
+ ("%R" . "%H:%M")
+ ("%T" . "%H:%M:%S")
+ ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon.
+ ("%Z" . "") ; time zone name
+ ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format
+ ("%g" . "%y")
+ ("%X" . "%x" ) ; locale's pref. time format
+ ("%j" . "") ; day of the year
+ ("%l" . "%k") ; like %I blank-padded
+ ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000
+ ("%n" . "<text:line-break/>")
+ ("%r" . "%I:%M:%S %p")
+ ("%t" . "<text:tab/>")
+ ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6)
+ ("%x" . "%Y-%M-%d %a") ; locale's pref. time format
+ ("%z" . "") ; time zone in numeric form
+ ))
+ (while (string-match re fmt start)
+ (setq match (match-string 0 fmt))
+ (setq rpl (assoc-default match fmt-alist))
+ (setq start (match-end 0))
+ (setq filler-end (match-beginning 0))
+ (setq filler (substring fmt (prog1 filler-beg
+ (setq filler-beg (match-end 0)))
+ filler-end))
+ (setq filler (and (not (string= filler ""))
+ (format "<number:text>%s</number:text>"
+ (org-odt--encode-plain-text filler))))
+ (setq output (concat output "\n" filler "\n" rpl)))
+ (setq filler (substring fmt filler-beg))
+ (unless (string= filler "")
+ (setq output (concat output
+ (format "\n<number:text>%s</number:text>"
+ (org-odt--encode-plain-text filler)))))
+ (format "\n<number:date-style style:name=\"%s\" %s>%s\n</number:date-style>"
+ style
+ (concat " number:automatic-order=\"true\""
+ " number:format-source=\"fixed\"")
+ output ))))
+
+(defun org-odt-template (contents info)
+ "Return complete document string after ODT 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))))
+ (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)
+ ;; Date, if required.
+ (when (plist-get info :with-date)
+ ;; Check if DATE is specified as an Org-timestamp. If yes,
+ ;; include it as meta information. Otherwise, just use
+ ;; today's date.
+ (let* ((date (let ((date (plist-get info :date)))
+ (and (not (cdr date))
+ (eq (org-element-type (car date)) 'timestamp)
+ (car date)))))
+ (let ((iso-date (org-odt--format-timestamp date nil 'iso-date)))
+ (concat
+ (format "<dc:date>%s</dc:date>\n" iso-date)
+ (format "<meta:creation-date>%s</meta:creation-date>\n"
+ iso-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-odt-zip-dir "meta.xml"))
+ ;; Add meta.xml in to manifest.
+ (org-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.
+ (styles-file (or styles-file
+ org-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 org-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-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-odt-zip-dir "styles.xml") t))
+ ((member styles-file-type '("odt" "ott"))
+ (org-odt--zip-extract styles-file "styles.xml" org-odt-zip-dir)))))
+ (t
+ (error (format "Invalid specification of styles.xml file: %S"
+ org-odt-styles-file))))
+
+ ;; create a manifest entry for styles.xml
+ (org-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-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-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.
+
+ (let* ( ;; `org-display-custom-times' should be accessed right
+ ;; within the context of the Org buffer. So obtain it's
+ ;; value before moving on to temp-buffer context down below.
+ (custom-time-fmts
+ (if org-display-custom-times
+ (cons (substring (car org-time-stamp-custom-formats) 1 -1)
+ (substring (cdr org-time-stamp-custom-formats) 1 -1))
+ '("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M"))))
+ (with-temp-buffer
+ (insert-file-contents
+ (or org-odt-content-template-file
+ (expand-file-name "OrgOdtContentTemplate.xml"
+ org-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-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))))
+ ;; - Dump date-styles.
+ (when org-odt-use-date-fields
+ (insert (org-odt--build-date-styles (car custom-time-fmts)
+ "OrgDate1")
+ (org-odt--build-date-styles (cdr custom-time-fmts)
+ "OrgDate2")))
+ ;; 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-odt-display-outline-level (nth 1 x)))
+ org-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)))))
+ (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)))
+ (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 E-mail.
+ (concat
+ (format
+ "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (format
+ "<text:a xlink:type=\"simple\" xlink:href=\"%s\">%s</text:a>"
+ (concat "mailto:" email)
+ (format "<text:initial-creator>%s</text:initial-creator>" author)))
+ ;; Separator.
+ "\n<text:p text:style-name=\"OrgSubtitle\"/>")))
+ ;; Date, if required.
+ (when (plist-get info :with-date)
+ (let* ((date (plist-get info :date))
+ ;; Check if DATE is specified as a timestamp.
+ (timestamp (and (not (cdr date))
+ (eq (org-element-type (car date)) 'timestamp)
+ (car date))))
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (if (and org-odt-use-date-fields timestamp)
+ (org-odt--format-timestamp (car date))
+ (org-export-data (plist-get info :date) info)))
+ ;; Separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>"))))))
+ ;; Table of Contents
+ (let* ((with-toc (plist-get info :with-toc))
+ (depth (and with-toc (if (wholenump with-toc)
+ with-toc
+ (plist-get info :headline-levels)))))
+ (when depth (insert (or (org-odt-toc depth info) ""))))
+ ;; Contents.
+ (insert contents)
+ ;; Return contents.
+ (buffer-substring-no-properties (point-min) (point-max)))))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-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-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."
+ contents)
+
+
+;;;; Clock
+
+(defun org-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."
+ (let ((timestamp (org-element-property :value clock))
+ (duration (org-element-property :duration clock)))
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ (if (eq (org-element-type (org-export-get-next-element clock info))
+ 'clock) "OrgClock" "OrgClockLastLine")
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgClockKeyword" org-clock-string)
+ (org-odt-timestamp timestamp contents info)
+ (and duration (format " (%s)" duration))))))
+
+
+;;;; Code
+
+(defun org-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-odt--encode-plain-text
+ (org-element-property :value code))))
+
+
+;;;; Comment
+
+;; Comments are ignored.
+
+
+;;;; Comment Block
+
+;; Comment Blocks are ignored.
+
+
+;;;; Drawer
+
+(defun org-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-odt-format-drawer-function)
+ (funcall org-odt-format-drawer-function
+ name contents)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents)))
+ output))
+
+
+;;;; Dynamic Block
+
+(defun org-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'."
+ contents)
+
+
+;;;; Entity
+
+(defun org-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."
+ (org-element-property :utf-8 entity))
+
+
+;;;; Example Block
+
+(defun org-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-odt-format-code example-block info))
+
+
+;;;; Export Snippet
+
+(defun org-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) 'odt)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Export Block
+
+(defun org-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-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-odt-do-format-code (org-element-property :value fixed-width)))
+
+
+;;;; Footnote Definition
+
+;; Footnote Definitions are ignored.
+
+
+;;;; Footnote Reference
+
+(defun org-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-with-backend
+ raw
+ (org-export-create-backend
+ :parent 'odt
+ :transcoders
+ '((paragraph . (lambda (p c i)
+ (org-odt--format-paragraph
+ p c "Footnote"
+ "OrgFootnoteCenter"
+ "OrgFootnoteQuotations")))))
+ 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-odt-format-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ (concat
+ ;; Todo.
+ (when todo
+ (let ((style (if (member todo org-done-keywords) "OrgDone" "OrgTodo")))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style todo)))
+ (when priority
+ (let* ((style (format "OrgPriority-%s" priority))
+ (priority (format "[#%c]" priority)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style priority)))
+ ;; Title.
+ text
+ ;; Tags.
+ (when tags
+ (concat
+ "<text:tab/>"
+ (format "<text:span text:style-name=\"%s\">[%s]</text:span>"
+ "OrgTags" (mapconcat
+ (lambda (tag)
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTag" tag)) tags " : "))))))
+
+(defun org-odt-format-headline--wrap (headline backend info
+ &optional format-function
+ &rest extra-keys)
+ "Transcode a HEADLINE element using BACKEND.
+INFO is a plist holding contextual information."
+ (setq backend (or backend (plist-get info :back-end)))
+ (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-with-backend todo backend 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-with-backend
+ (org-element-property :title headline) backend 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-odt-format-headline-function)
+ (function*
+ (lambda (todo todo-type priority text tags
+ &allow-other-keys)
+ (funcall org-odt-format-headline-function
+ todo todo-type priority text tags))))
+ (t 'org-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-odt-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to ODT.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ ;; Case 1: This is a footnote section: ignore it.
+ (unless (org-element-property :footnote-section-p headline)
+ (let* ((text (org-export-data (org-element-property :title headline) info))
+ ;; Create the headline text.
+ (full-text (org-odt-format-headline--wrap headline nil info))
+ ;; Get level relative to current parsed data.
+ (level (org-export-get-relative-level headline info))
+ ;; Get canonical label for the headline.
+ (id (concat "sec-" (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ headline info) "-")))
+ ;; Get user-specified labels for the headline.
+ (extra-ids (list (org-element-property :CUSTOM_ID headline)
+ (org-element-property :ID headline)))
+ ;; Extra targets.
+ (extra-targets
+ (mapconcat (lambda (x)
+ (when x
+ (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x)))
+ (org-odt--target
+ "" (org-export-solidify-link-text x)))))
+ extra-ids ""))
+ ;; Title.
+ (anchored-title (org-odt--target full-text id)))
+ (cond
+ ;; 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)
+ ;; Build the real contents of the sub-tree.
+ (concat
+ (and (org-export-first-sibling-p headline info)
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ ;; Choose style based on list type.
+ (if (org-export-numbered-headline-p headline info)
+ "OrgNumberedList" "OrgBulletedList")
+ ;; If top-level list, re-start numbering. Otherwise,
+ ;; continue numbering.
+ (format "text:continue-numbering=\"%s\""
+ (let* ((parent (org-export-get-parent-headline
+ headline)))
+ (if (and parent
+ (org-export-low-level-p parent info))
+ "true" "false")))))
+ (let ((headline-has-table-p
+ (let ((section (assq 'section (org-element-contents headline))))
+ (assq 'table (and section (org-element-contents section))))))
+ (format "\n<text:list-item>\n%s\n%s"
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (concat extra-targets anchored-title))
+ contents)
+ (if headline-has-table-p
+ "</text:list-header>"
+ "</text:list-item>")))
+ (and (org-export-last-sibling-p headline info)
+ "</text:list>")))
+ ;; Case 3. Standard headline. Export it as a section.
+ (t
+ (concat
+ (format
+ "\n<text:h text:style-name=\"%s\" text:outline-level=\"%s\">%s</text:h>"
+ (format "Heading_20_%s" level)
+ level
+ (concat extra-targets anchored-title))
+ contents))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-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."
+ (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-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-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-odt--find-verb-separator code)))
+ (error "FIXME")))
+
+
+;;;; Inlinetask
+
+(defun org-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-odt-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ ((functionp org-odt-format-inlinetask-function)
+ (let ((format-function
+ (function*
+ (lambda (todo todo-type priority text tags
+ &key contents &allow-other-keys)
+ (funcall org-odt-format-inlinetask-function
+ todo todo-type priority text tags contents)))))
+ (org-odt-format-headline--wrap
+ inlinetask nil info format-function :contents contents)))
+ ;; Otherwise, use a default template.
+ (t
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (org-odt--textbox
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgInlineTaskHeading"
+ (org-odt-format-headline--wrap inlinetask nil info))
+ contents)
+ nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))))
+
+;;;; Italic
+
+(defun org-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-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-odt--checkbox item)
+ (org-export-data tag info))))))
+ (case type
+ ((ordered unordered descriptive-1 descriptive-2)
+ (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>")))))
+ (t (error "Unknown list type: %S" type)))))
+
+;;;; Keyword
+
+(defun org-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 "ODT") value)
+ ((string= key "INDEX")
+ ;; FIXME
+ (ignore))
+ ((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-odt-toc depth info))))
+ ((member value '("tables" "figures" "listings"))
+ ;; FIXME
+ (ignore))))))))
+
+
+;;;; Latex Environment
+
+
+;; (eval-after-load 'ox-odt '(ad-deactivate 'org-format-latex-as-mathml))
+;; (defadvice org-format-latex-as-mathml ; FIXME
+;; (after org-odt-protect-latex-fragment activate)
+;; "Encode LaTeX fragment as XML.
+;; Do this when translation to MathML fails."
+;; (unless (> (length ad-return-value) 0)
+;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0)))))
+
+(defun org-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."
+ (let* ((latex-frag (org-remove-indentation
+ (org-element-property :value latex-environment))))
+ (org-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-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 :with-latex)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" (org-odt--encode-plain-text latex-frag t))))
+
+
+;;;; Line Break
+
+(defun org-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/>")
+
+
+;;;; Link
+
+;;;; Links :: Label references
+
+(defun org-odt--enumerate (element info &optional predicate n)
+ (when predicate (assert (funcall predicate element info)))
+ (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-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-odt-format-label (element info op)
+ "Return a label for ELEMENT.
+
+ELEMENT is a `link', `table', `src-block' or `paragraph' type
+element. INFO is a plist used as a communication channel. OP is
+either `definition' or `reference', depending on the purpose of
+the generated string.
+
+Return value is a string if OP is set to `reference' or a cons
+cell like CAPTION . SHORT-CAPTION) where CAPTION and
+SHORT-CAPTION are strings."
+ (assert (memq (org-element-type element) '(link table src-block paragraph)))
+ (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-export-get-caption caption-from))
+ (short-caption (org-export-get-caption caption-from t))
+ ;; Transcode captions.
+ (caption (and caption (org-export-data caption info)))
+ ;; Currently short caption are sneaked in as object names.
+ ;;
+ ;; The advantages are:
+ ;;
+ ;; - Table Of Contents: Currently, there is no support for
+ ;; building TOC for figures, listings and tables. See
+ ;; `org-odt-keyword'. User instead has to rely on
+ ;; external application for building such indices. Within
+ ;; LibreOffice, building an "Illustration Index" or "Index
+ ;; of Tables" will create a table with long captions (only)
+ ;; and building a table with "Object names" will create a
+ ;; table with short captions.
+ ;;
+ ;; - Easy navigation: In LibreOffice, object names are
+ ;; offered via the navigation bar. This way one can
+ ;; quickly locate and jump to object of his choice in the
+ ;; exported document.
+ ;;
+ ;; The main disadvantage is that there cannot be any markups
+ ;; within object names i.e., one cannot embolden, italicize
+ ;; or underline text within short caption. So suppress
+ ;; generation of <text:span >...</text:span> and other
+ ;; markups by overriding the default translators. We
+ ;; probably shouldn't be suppressing translators for all
+ ;; elements in `org-element-all-objects', but for now this
+ ;; will do.
+ (short-caption
+ (let ((short-caption (or short-caption caption))
+ (backend (org-export-create-backend
+ :parent (org-export-backend-name
+ (plist-get info :back-end))
+ :transcoders
+ (mapcar (lambda (type) (cons type (lambda (o c i) c)))
+ org-element-all-objects))))
+ (when short-caption
+ (org-export-data-with-backend short-caption backend info)))))
+ (when (or label caption)
+ (let* ((default-category
+ (case (org-element-type element)
+ (table "__Table__")
+ (src-block "__Listing__")
+ ((link paragraph)
+ (cond
+ ((org-odt--enumerable-latex-image-p element info)
+ "__DvipngImage__")
+ ((org-odt--enumerable-image-p element info)
+ "__Figure__")
+ ((org-odt--enumerable-formula-p element info)
+ "__MathFormula__")
+ (t (error "Don't know how to format label for link: %S"
+ element))))
+ (t (error "Don't know how to format label for element type: %s"
+ (org-element-type element)))))
+ seqno)
+ (assert default-category)
+ (destructuring-bind (counter label-style category predicate)
+ (assoc-default default-category org-odt-category-map-alist)
+ ;; Compute sequence number of the element.
+ (setq seqno (org-odt--enumerate element info predicate))
+ ;; Localize category string.
+ (setq category (org-export-translate category :utf-8 info))
+ (case op
+ ;; Case 1: Handle Label definition.
+ (definition
+ ;; Assign an internal label, if user has not provided one
+ (setq label (org-export-solidify-link-text
+ (or label (format "%s-%s" default-category seqno))))
+ (cons
+ (concat
+ ;; Sneak in a bookmark. The bookmark is used when the
+ ;; labeled element is referenced with a link that
+ ;; provides it's own description.
+ (format "\n<text:bookmark text:name=\"%s\"/>" label)
+ ;; Label definition: Typically formatted as below:
+ ;; CATEGORY SEQ-NO: LONG CAPTION
+ ;; with translation for correct punctuation.
+ (format-spec
+ (org-export-translate
+ (cadr (assoc-string label-style org-odt-label-styles t))
+ :utf-8 info)
+ `((?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))
+ ;; Case 2: Handle Label reference.
+ (reference
+ (assert label)
+ (setq label (org-export-solidify-link-text label))
+ (let* ((fmt (cddr (assoc-string label-style org-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 "Unknown %S on label" op))))))))
+
+
+;;;; Links :: Inline Images
+
+(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))
+ (target-dir "Images/")
+ (target-file
+ (format "%s%04d.%s" target-dir
+ (incf org-odt-embedded-images-count) image-type)))
+ (message "Embedding %s as %s..."
+ (substring-no-properties path) target-file)
+
+ (when (= 1 org-odt-embedded-images-count)
+ (make-directory (concat org-odt-zip-dir target-dir))
+ (org-odt-create-manifest-file-entry "" target-dir))
+
+ (copy-file path (concat org-odt-zip-dir target-file) 'overwrite)
+ (org-odt-create-manifest-file-entry media-type target-file)
+ target-file))
+
+(defun org-odt--image-size (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-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-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-odt-max-image-size))
+ (max-height (cdr org-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)))
+
+(defun org-odt-link--inline-image (element info)
+ "Return ODT code for an inline image.
+LINK is the link pointing to the inline image. INFO is a plist
+used as a communication channel."
+ (assert (eq (org-element-type element) 'link))
+ (let* ((src (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))))
+ (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-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. Read
+ ;; them as numbers since we need them for computations.
+ (size (org-odt--image-size
+ src-expanded
+ (let ((width (plist-get attr-plist :width)))
+ (and width (read width)))
+ (let ((length (plist-get attr-plist :length)))
+ (and length (read length)))
+ (let ((scale (plist-get attr-plist :scale)))
+ (and scale (read scale)))
+ nil ; embed-as
+ "paragraph" ; FIXME
+ ))
+ (width (car size)) (height (cdr size))
+ (standalone-link-p (org-odt--standalone-link-p element info))
+ (embed-as (if standalone-link-p "paragraph" "as-char"))
+ (captions (org-odt-format-label element info 'definition))
+ (caption (car captions)) (short-caption (cdr captions))
+ (entity (concat (and caption "Captioned") embed-as "Image"))
+ ;; Check if this link was created by LaTeX-to-PNG converter.
+ (replaces (org-element-property
+ :replaces (if (not standalone-link-p) element
+ (org-export-get-parent-element element))))
+ ;; If yes, note down the type of the element - LaTeX Fragment
+ ;; or LaTeX environment. It will go in to frame title.
+ (title (and replaces (capitalize
+ (symbol-name (org-element-type replaces)))))
+
+ ;; If yes, note down it's contents. It will go in to frame
+ ;; description. This quite useful for debugging.
+ (desc (and replaces (org-element-property :value replaces))))
+ (org-odt--render-image/formula entity href width height
+ captions user-frame-params title desc)))
+
+
+;;;; Links :: Math formula
+
+(defun org-odt-link--inline-formula (element info)
+ (let* ((src (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))))
+ (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:object %s xlink:href=\"%s\" xlink:type=\"simple\"/>"
+ " xlink:show=\"embed\" xlink:actuate=\"onLoad\""
+ (file-name-directory (org-odt--copy-formula-file src-expanded))))
+ (standalone-link-p (org-odt--standalone-link-p element info))
+ (embed-as (if standalone-link-p 'paragraph 'character))
+ (captions (org-odt-format-label element info 'definition))
+ (caption (car captions)) (short-caption (cdr captions))
+ ;; Check if this link was created by LaTeX-to-MathML
+ ;; converter.
+ (replaces (org-element-property
+ :replaces (if (not standalone-link-p) element
+ (org-export-get-parent-element element))))
+ ;; If yes, note down the type of the element - LaTeX Fragment
+ ;; or LaTeX environment. It will go in to frame title.
+ (title (and replaces (capitalize
+ (symbol-name (org-element-type replaces)))))
+
+ ;; If yes, note down it's contents. It will go in to frame
+ ;; description. This quite useful for debugging.
+ (desc (and replaces (org-element-property :value replaces)))
+ width height)
+ (cond
+ ((eq embed-as 'character)
+ (org-odt--render-image/formula "InlineFormula" href width height
+ nil nil title desc))
+ (t
+ (let* ((equation (org-odt--render-image/formula
+ "CaptionedDisplayFormula" href width height
+ captions nil title desc))
+ (label
+ (let* ((org-odt-category-map-alist
+ '(("__MathFormula__" "Text" "math-label" "Equation"
+ org-odt--enumerable-formula-p))))
+ (car (org-odt-format-label element info 'definition)))))
+ (concat equation "<text:tab/>" label))))))
+
+(defun org-odt--copy-formula-file (src-file)
+ "Returns the internal name of the file"
+ (let* ((target-dir (format "Formula-%04d/"
+ (incf org-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-odt-zip-dir target-dir))
+ (org-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-odt-zip-dir target-file) 'overwrite))
+ ;; Case 2: OpenDocument formula.
+ ((string-match "\\.odf\\'" src-file)
+ (org-odt--zip-extract src-file "content.xml"
+ (concat org-odt-zip-dir target-dir)))
+ (t (error "%s is not a formula file" src-file))))
+ ;; Enter the formula file in to manifest.
+ (org-odt-create-manifest-file-entry "text/xml" target-file)
+ target-file))
+
+;;;; Targets
+
+(defun org-odt--render-image/formula (cfg-key href width height &optional
+ captions user-frame-params
+ &rest title-and-desc)
+ (let* ((frame-cfg-alist
+ ;; Each element of this alist is of the form (CFG-HANDLE
+ ;; INNER-FRAME-PARAMS OUTER-FRAME-PARAMS).
+
+ ;; CFG-HANDLE is the key to the alist.
+
+ ;; INNER-FRAME-PARAMS and OUTER-FRAME-PARAMS specify the
+ ;; frame params for INNER-FRAME and OUTER-FRAME
+ ;; respectively. See below.
+
+ ;; Configurations that are meant to be applied to
+ ;; non-captioned image/formula specifies no
+ ;; OUTER-FRAME-PARAMS.
+
+ ;; TERMINOLOGY
+ ;; ===========
+ ;; INNER-FRAME :: Frame that directly surrounds an
+ ;; image/formula.
+
+ ;; OUTER-FRAME :: Frame that encloses the INNER-FRAME. This
+ ;; frame also contains the caption, if any.
+
+ ;; FRAME-PARAMS :: List of the form (FRAME-STYLE-NAME
+ ;; FRAME-ATTRIBUTES FRAME-ANCHOR). Note
+ ;; that these are the last three arguments
+ ;; to `org-odt--frame'.
+
+ ;; Note that an un-captioned image/formula requires just an
+ ;; INNER-FRAME, while a captioned image/formula requires
+ ;; both an INNER and an OUTER-FRAME.
+ '(("As-CharImage" ("OrgInlineImage" nil "as-char"))
+ ("ParagraphImage" ("OrgDisplayImage" nil "paragraph"))
+ ("PageImage" ("OrgPageImage" nil "page"))
+ ("CaptionedAs-CharImage"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgInlineImage" nil "as-char"))
+ ("CaptionedParagraphImage"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgImageCaptionFrame" nil "paragraph"))
+ ("CaptionedPageImage"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgPageImageCaptionFrame" nil "page"))
+ ("InlineFormula" ("OrgInlineFormula" nil "as-char"))
+ ("DisplayFormula" ("OrgDisplayFormula" nil "as-char"))
+ ("CaptionedDisplayFormula"
+ ("OrgCaptionedFormula" nil "paragraph")
+ ("OrgFormulaCaptionFrame" nil "paragraph"))))
+ (caption (car captions)) (short-caption (cdr captions))
+ ;; Retrieve inner and outer frame params, from configuration.
+ (frame-cfg (assoc-string cfg-key frame-cfg-alist t))
+ (inner (nth 1 frame-cfg))
+ (outer (nth 2 frame-cfg))
+ ;; User-specified frame params (from #+ATTR_ODT spec)
+ (user user-frame-params)
+ (--merge-frame-params (function
+ (lambda (default user)
+ "Merge default and user frame params."
+ (if (not user) default
+ (assert (= (length default) 3))
+ (assert (= (length user) 3))
+ (loop for u in user
+ for d in default
+ collect (or u d)))))))
+ (cond
+ ;; Case 1: Image/Formula has no caption.
+ ;; There is only one frame, one that surrounds the image
+ ;; or formula.
+ ((not caption)
+ ;; Merge user frame params with that from configuration.
+ (setq inner (funcall --merge-frame-params inner user))
+ (apply 'org-odt--frame href width height
+ (append inner title-and-desc)))
+ ;; Case 2: Image/Formula is captioned or labeled.
+ ;; There are two frames: The inner one surrounds the
+ ;; image or formula. The outer one contains the
+ ;; caption/sequence number.
+ (t
+ ;; Merge user frame params with outer frame params.
+ (setq outer (funcall --merge-frame-params outer user))
+ ;; Short caption, if specified, goes as part of inner frame.
+ (setq inner (let ((frame-params (copy-sequence inner)))
+ (setcar (cdr frame-params)
+ (concat
+ (cadr frame-params)
+ (when short-caption
+ (format " draw:name=\"%s\" " short-caption))))
+ frame-params))
+ (apply 'org-odt--textbox
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Illustration"
+ (concat
+ (apply 'org-odt--frame href width height
+ (append inner title-and-desc))
+ caption))
+ width height outer)))))
+
+(defun org-odt--enumerable-p (element info)
+ ;; Element should have a caption or label.
+ (or (org-element-property :caption element)
+ (org-element-property :name element)))
+
+(defun org-odt--enumerable-image-p (element info)
+ (org-odt--standalone-link-p
+ element info
+ ;; Paragraph should have a caption or label. It SHOULD NOT be a
+ ;; replacement element. (i.e., It SHOULD NOT be a result of LaTeX
+ ;; processing.)
+ (lambda (p)
+ (and (not (org-element-property :replaces p))
+ (or (org-element-property :caption p)
+ (org-element-property :name p))))
+ ;; Link should point to an image file.
+ (lambda (l)
+ (assert (eq (org-element-type l) 'link))
+ (org-export-inline-image-p l org-odt-inline-image-rules))))
+
+(defun org-odt--enumerable-latex-image-p (element info)
+ (org-odt--standalone-link-p
+ element info
+ ;; Paragraph should have a caption or label. It SHOULD also be a
+ ;; replacement element. (i.e., It SHOULD be a result of LaTeX
+ ;; processing.)
+ (lambda (p)
+ (and (org-element-property :replaces p)
+ (or (org-element-property :caption p)
+ (org-element-property :name p))))
+ ;; Link should point to an image file.
+ (lambda (l)
+ (assert (eq (org-element-type l) 'link))
+ (org-export-inline-image-p l org-odt-inline-image-rules))))
+
+(defun org-odt--enumerable-formula-p (element info)
+ (org-odt--standalone-link-p
+ element info
+ ;; Paragraph should have a caption or label.
+ (lambda (p)
+ (or (org-element-property :caption p)
+ (org-element-property :name p)))
+ ;; Link should point to a MathML or ODF file.
+ (lambda (l)
+ (assert (eq (org-element-type l) 'link))
+ (org-export-inline-image-p l org-odt-inline-formula-rules))))
+
+(defun org-odt--standalone-link-p (element info &optional
+ paragraph-predicate
+ link-predicate)
+ "Test if ELEMENT is a standalone link for the purpose ODT export.
+INFO is a plist holding contextual information.
+
+Return non-nil, if ELEMENT is of type paragraph satisfying
+PARAGRAPH-PREDICATE and it's sole content, save for whitespaces,
+is a link that satisfies LINK-PREDICATE.
+
+Return non-nil, if ELEMENT is of type link satisfying
+LINK-PREDICATE and it's containing paragraph satisfies
+PARAGRAPH-PREDICATE inaddtion to having no other content save for
+leading and trailing whitespaces.
+
+Return nil, otherwise."
+ (let ((p (case (org-element-type element)
+ (paragraph element)
+ (link (and (or (not link-predicate)
+ (funcall link-predicate element))
+ (org-export-get-parent element)))
+ (t nil))))
+ (when (and p (eq (org-element-type p) 'paragraph))
+ (when (or (not paragraph-predicate)
+ (funcall paragraph-predicate p))
+ (let ((contents (org-element-contents p)))
+ (loop for x in contents
+ with inline-image-count = 0
+ always (case (org-element-type x)
+ (plain-text
+ (not (org-string-nw-p x)))
+ (link
+ (and (or (not link-predicate)
+ (funcall link-predicate x))
+ (= (incf inline-image-count) 1)))
+ (t nil))))))))
+
+(defun org-odt-link--infer-description (destination info)
+ ;; DESTINATION is a HEADLINE, a "<<target>>" or an element (like
+ ;; paragraph, verse-block etc) to which a "#+NAME: label" can be
+ ;; attached. Note that labels that are attached to captioned
+ ;; entities - inline images, math formulae and tables - get resolved
+ ;; as part of `org-odt-format-label' and `org-odt--enumerate'.
+
+ ;; Create a cross-reference to DESTINATION but make best-efforts to
+ ;; create a *meaningful* description. Check item numbers, section
+ ;; number and section title in that order.
+
+ ;; NOTE: Counterpart of `org-export-get-ordinal'.
+ ;; FIXME: Handle footnote-definition footnote-reference?
+ (let* ((genealogy (org-export-get-genealogy destination))
+ (data (reverse genealogy))
+ (label (case (org-element-type destination)
+ (headline
+ (format "sec-%s" (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ destination info) "-")))
+ (target
+ (org-element-property :value destination))
+ (t (error "FIXME: Resolve %S" destination)))))
+ (or
+ (let* ( ;; Locate top-level list.
+ (top-level-list
+ (loop for x on data
+ when (eq (org-element-type (car x)) 'plain-list)
+ return x))
+ ;; Get list item nos.
+ (item-numbers
+ (loop for (plain-list item . rest) on top-level-list by #'cddr
+ until (not (eq (org-element-type plain-list) 'plain-list))
+ collect (when (eq (org-element-property :type
+ plain-list)
+ 'ordered)
+ (1+ (length (org-export-get-previous-element
+ item info t))))))
+ ;; Locate top-most listified headline.
+ (listified-headlines
+ (loop for x on data
+ when (and (eq (org-element-type (car x)) 'headline)
+ (org-export-low-level-p (car x) info))
+ return x))
+ ;; Get listified headline numbers.
+ (listified-headline-nos
+ (loop for el in listified-headlines
+ when (eq (org-element-type el) 'headline)
+ collect (when (org-export-numbered-headline-p el info)
+ (1+ (length (org-export-get-previous-element
+ el info t)))))))
+ ;; Combine item numbers from both the listified headlines and
+ ;; regular list items.
+
+ ;; Case 1: Check if all the parents of list item are numbered.
+ ;; If yes, link to the item proper.
+ (let ((item-numbers (append listified-headline-nos item-numbers)))
+ (when (and item-numbers (not (memq nil item-numbers)))
+ (format "<text:bookmark-ref text:reference-format=\"number-all-superior\" text:ref-name=\"%s\">%s</text:bookmark-ref>"
+ (org-export-solidify-link-text label)
+ (mapconcat (lambda (n) (if (not n) " "
+ (concat (number-to-string n) ".")))
+ item-numbers "")))))
+ ;; Case 2: Locate a regular and numbered headline in the
+ ;; hierarchy. Display it's section number.
+ (let ((headline (loop for el in (cons destination genealogy)
+ when (and (eq (org-element-type el) 'headline)
+ (not (org-export-low-level-p el info))
+ (org-export-numbered-headline-p el info))
+ return el)))
+ ;; We found one.
+ (when headline
+ (format "<text:bookmark-ref text:reference-format=\"chapter\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
+ (org-export-solidify-link-text label)
+ (mapconcat 'number-to-string (org-export-get-headline-number
+ headline info) "."))))
+ ;; Case 4: Locate a regular headline in the hierarchy. Display
+ ;; it's title.
+ (let ((headline (loop for el in (cons destination genealogy)
+ when (and (eq (org-element-type el) 'headline)
+ (not (org-export-low-level-p el info)))
+ return el)))
+ ;; We found one.
+ (when headline
+ (format "<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
+ (org-export-solidify-link-text label)
+ (let ((title (org-element-property :title headline)))
+ (org-export-data title info)))))
+ (error "FIXME?"))))
+
+(defun org-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-odt-inline-image-rules))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ (if (file-name-absolute-p raw-path)
+ (concat "file://" (expand-file-name raw-path))
+ (concat "file://" raw-path)))
+ (t raw-path)))
+ ;; Convert & to &amp; for correct XML representation
+ (path (replace-regexp-in-string "&" "&amp;" path))
+ protocol)
+ (cond
+ ;; Image file.
+ ((and (not desc) (org-export-inline-image-p
+ link org-odt-inline-image-rules))
+ (org-odt-link--inline-image link info))
+ ;; Formula file.
+ ((and (not desc) (org-export-inline-image-p
+ link org-odt-inline-formula-rules))
+ (org-odt-link--inline-formula 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
+ (let ((desc (org-export-data (org-element-contents destination) info))
+ (href (org-export-solidify-link-text path)))
+ (format
+ "<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
+ href desc)))))
+ ;; Links pointing to a 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)
+ ;; Case 1: 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))))
+ ;; Case 2: Fuzzy link points to a headline.
+ (headline
+ ;; If there's a description, create a hyperlink.
+ ;; Otherwise, try to provide a meaningful description.
+ (if (not desc) (org-odt-link--infer-description destination info)
+ (let* ((headline-no
+ (org-export-get-headline-number destination info))
+ (label
+ (format "sec-%s"
+ (mapconcat 'number-to-string headline-no "-"))))
+ (format
+ "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ label desc))))
+ ;; Case 3: Fuzzy link points to a target.
+ (target
+ ;; If there's a description, create a hyperlink.
+ ;; Otherwise, try to provide a meaningful description.
+ (if (not desc) (org-odt-link--infer-description destination info)
+ (let ((label (org-element-property :value destination)))
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ (org-export-solidify-link-text label)
+ desc))))
+ ;; Case 4: Fuzzy link points to some element (e.g., an
+ ;; inline image, a math formula or a table).
+ (otherwise
+ (let ((label-reference
+ (ignore-errors (org-odt-format-label
+ destination info 'reference))))
+ (cond ((not label-reference)
+ (org-odt-link--infer-description destination info))
+ ;; LINK has no description. Create
+ ;; a cross-reference showing entity's sequence
+ ;; number.
+ ((not desc) label-reference)
+ ;; LINK has description. Insert a hyperlink with
+ ;; user-provided description.
+ (t
+ (let ((label (org-element-property :name destination)))
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ (org-export-solidify-link-text label)
+ desc)))))))))
+ ;; Coderef: replace link with the reference name or the
+ ;; equivalent line number.
+ ((string= type "coderef")
+ (let* ((line-no (format "%d" (org-export-resolve-coderef path info)))
+ (href (concat "coderef-" path)))
+ (format
+ (org-export-get-coderef-format path desc)
+ (format
+ "<text:bookmark-ref text:reference-format=\"number\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
+ href line-no))))
+ ;; 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)
+ (let ((link-contents (org-element-contents link)))
+ ;; Check if description is a link to an inline image.
+ (if (and (not (cdr link-contents))
+ (let ((desc-element (car link-contents)))
+ (and (eq (org-element-type desc-element) 'link)
+ (org-export-inline-image-p
+ desc-element org-odt-inline-image-rules))))
+ ;; Format link as a clickable image.
+ (format "\n<draw:a xlink:type=\"simple\" xlink:href=\"%s\">\n%s\n</draw:a>"
+ path desc)
+ ;; Otherwise, format it as a regular link.
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"%s\">%s</text:a>"
+ path desc))))
+ ;; External link without a description part.
+ (path
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"%s\">%s</text:a>"
+ path path))
+ ;; No path, only description. Try to do something useful.
+ (t (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Emphasis" desc)))))
+
+
+;;;; Paragraph
+
+(defun org-odt--format-paragraph (paragraph contents default center quote)
+ "Format paragraph according to given styles.
+PARAGRAPH is a paragraph type element. CONTENTS is the
+transcoded contents of that paragraph, as a string. DEFAULT,
+CENTER and QUOTE are, respectively, style to use when paragraph
+belongs to no special environment, a center block, or a quote
+block."
+ (let* ((parent (org-export-get-parent paragraph))
+ (parent-type (org-element-type parent))
+ (style (case parent-type
+ (quote-block quote)
+ (center-block center)
+ (t default))))
+ ;; If this paragraph is a leading paragraph in an item and the
+ ;; item has a checkbox, splice the checkbox and paragraph contents
+ ;; together.
+ (when (and (eq (org-element-type parent) 'item)
+ (eq paragraph (car (org-element-contents parent))))
+ (setq contents (concat (org-odt--checkbox parent) contents)))
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>" style contents)))
+
+(defun org-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."
+ (org-odt--format-paragraph
+ paragraph contents
+ (or (org-element-property :style paragraph) "Text_20_body")
+ "OrgCenter"
+ "Quotations"))
+
+
+;;;; Plain List
+
+(defun org-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."
+ (format "\n<text:list text:style-name=\"%s\" %s>\n%s</text:list>"
+ ;; Choose style based on list type.
+ (case (org-element-property :type plain-list)
+ (ordered "OrgNumberedList")
+ (unordered "OrgBulletedList")
+ (descriptive-1 "OrgDescriptionList")
+ (descriptive-2 "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-odt--encode-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-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-odt--encode-tabs-and-spaces text)))
+
+(defun org-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."
+ (let ((output text))
+ ;; Protect &, < and >.
+ (setq output (org-odt--encode-plain-text output t))
+ ;; Handle smart quotes. Be sure to provide original string since
+ ;; OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output (org-export-activate-smart-quotes output :utf-8 info text)))
+ ;; Convert special strings.
+ (when (plist-get info :with-special-strings)
+ (mapc
+ (lambda (pair)
+ (setq output
+ (replace-regexp-in-string (car pair) (cdr pair) output t nil)))
+ org-odt-special-string-regexps))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" "<text:line-break/>" output t)))
+ ;; Return value.
+ output))
+
+
+;;;; Planning
+
+(defun org-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 "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgPlanning"
+ (concat
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgClosedKeyword" org-closed-string)
+ (org-odt-timestamp closed contents info))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgDeadlineKeyword" org-deadline-string)
+ (org-odt-timestamp deadline contents info))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgScheduledKeyword" org-deadline-string)
+ (org-odt-timestamp scheduled contents info)))))))
+
+
+;;;; Property Drawer
+
+(defun org-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-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."
+ contents)
+
+
+;;;; Quote Section
+
+(defun org-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-odt-do-format-code value))))
+
+
+;;;; Section
+
+(defun org-odt-format-section (text style &optional name)
+ (let ((default-name (car (org-odt-add-automatic-style "Section"))))
+ (format "\n<text:section text:style-name=\"%s\" %s>\n%s\n</text:section>"
+ style
+ (format "text:name=\"%s\"" (or name default-name))
+ text)))
+
+
+(defun org-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-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-odt--target
+ text (org-export-solidify-link-text
+ (org-element-property :value radio-target))))
+
+
+;;;; Special Block
+
+(defun org-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)))
+ (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)
+ ;; FIXME: Is `car' right thing to do below?
+ (car (plist-get info :date)))))
+ (format "\n<text:p>%s</text:p>"
+ (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-odt--format-timestamp date nil 'iso-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-odt--textbox contents width height
+ style extra anchor))))
+ (t contents))))
+
+
+;;;; Src Block
+
+(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-odt-create-custom-styles-for-srcblocks
+ (cond
+ ((eq fn 'default)
+ (format org-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-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-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>"))))
+ (org-no-warnings (htmlfontify-string line))))
+
+(defun org-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-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-odt-htmlfontify-string
+ 'org-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-odt--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-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-odt-do-format-code code lang refs retain-labels num-start)))
+
+(defun org-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))
+ (attributes (org-export-read-attribute :attr_odt src-block))
+ (captions (org-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-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-odt--textbox --src-block nil nil nil)))))))
+
+
+;;;; Statistics Cookie
+
+(defun org-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-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-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-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-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-odt-table-styles)))
+
+(defun org-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-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."
+ (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-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-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-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
+ (let ((cols (plist-get table-attrs :header-columns)))
+ (and cols (read cols)))))
+ (<= 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
+ (let ((table-cell-contents (org-element-contents table-cell)))
+ (if (memq (org-element-type (car table-cell-contents))
+ org-element-all-elements)
+ contents
+ (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-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-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-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
+ "(ox-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-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-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-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-odt-add-automatic-style "Table" attributes)))
+ (format
+ "\n<table:table table:style-name=\"%s\"%s>"
+ (or custom-table-style (cdr automatic-name) "OrgTable")
+ (concat (when short-caption
+ (format " table:name=\"%s\"" short-caption)))))
+ ;; column specification.
+ (funcall table-column-specs table info)
+ ;; actual contents.
+ "\n" contents
+ ;; end table.
+ "</table:table>")))))
+
+(defun org-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.
+
+Use `org-odt--table' to typeset the table. Handle details
+pertaining to indentation here."
+ (let* ((--element-preceded-by-table-p
+ (function
+ (lambda (element info)
+ (loop for el in (org-export-get-previous-element element info t)
+ 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 (memq (org-element-type el)
+ '(item plain-list))
+ collect el)))
+ (llh-genealogy
+ (apply 'nconc
+ (loop for el in genealogy
+ when (and (eq (org-element-type el) 'headline)
+ (org-export-low-level-p el info))
+ collect
+ (list el
+ (assq 'headline
+ (org-element-contents
+ (org-export-get-parent el)))))))
+ parent-list)
+ (nconc
+ ;; Handle list genealogy.
+ (loop for el in list-genealogy collect
+ (case (org-element-type el)
+ (plain-list
+ (setq parent-list el)
+ (cons "</text:list>"
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ (case (org-element-property :type el)
+ (ordered "OrgNumberedList")
+ (unordered "OrgBulletedList")
+ (descriptive-1 "OrgDescriptionList")
+ (descriptive-2 "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>"))))))
+ ;; Handle low-level headlines.
+ (loop for el in llh-genealogy
+ with step = 'item collect
+ (case step
+ (plain-list
+ (setq step 'item) ; Flip-flop
+ (setq parent-list el)
+ (cons "</text:list>"
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ (if (org-export-numbered-headline-p
+ el info)
+ "OrgNumberedList"
+ "OrgBulletedList")
+ "text:continue-numbering=\"true\"")))
+ (item
+ (setq step 'plain-list) ; Flip-flop
+ (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>")))
+ ((let ((section? (org-export-get-previous-element
+ parent-list info)))
+ (and section?
+ (eq (org-element-type section?) 'section)
+ (assq 'table (org-element-contents section?))))
+ '("</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.
+
+ ;; One solution - the easiest and lightweight, in terms of
+ ;; implementation - is to put the table in an indented text box
+ ;; and make the text box part of the list-item. Unfortunately if
+ ;; the table is big and spans multiple pages, the text box could
+ ;; overflow. In this case, the following attribute will come
+ ;; handy.
+
+ ;; ,---- From OpenDocument-v1.1.pdf
+ ;; | 15.27.28 Overflow behavior
+ ;; |
+ ;; | For text boxes contained within text document, the
+ ;; | style:overflow-behavior property specifies the behavior of text
+ ;; | boxes where the containing text does not fit into the text
+ ;; | box.
+ ;; |
+ ;; | If the attribute's value is clip, the text that does not fit
+ ;; | into the text box is not displayed.
+ ;; |
+ ;; | If the attribute value is auto-create-new-frame, a new frame
+ ;; | will be created on the next page, with the same position and
+ ;; | dimensions of the original frame.
+ ;; |
+ ;; | If the style:overflow-behavior property's value is
+ ;; | auto-create-new-frame and the text box has a minimum width or
+ ;; | height specified, then the text box will grow until the page
+ ;; | bounds are reached before a new frame is created.
+ ;; `----
+
+ ;; Unfortunately, LibreOffice-3.4.6 doesn't honor
+ ;; auto-create-new-frame property and always resorts to clipping
+ ;; the text box. This results in table being truncated.
+
+ ;; So we solve the problem the hard (and fun) way using list
+ ;; continuations.
+
+ ;; The problem only becomes more interesting if you take in to
+ ;; account the following facts:
+ ;;
+ ;; - Description lists are simulated as plain lists.
+ ;; - Low-level headlines can be listified.
+ ;; - In Org-mode, a table can occur not only as a regular list
+ ;; item, but also within description lists and low-level
+ ;; headlines.
+
+ ;; See `org-odt-translate-description-lists' and
+ ;; `org-odt-translate-low-level-headlines' for how this is
+ ;; tackled.
+
+ (concat "\n"
+ ;; Discontinue the list.
+ (mapconcat 'car close-open-tags "\n")
+ ;; Put the table in an indented section.
+ (let* ((table (org-odt--table table contents info))
+ (level (/ (length (mapcar 'car close-open-tags)) 2))
+ (style (format "OrgIndentedSection-Level-%d" level)))
+ (when table (org-odt-format-section table style)))
+ ;; Continue the list.
+ (mapconcat 'cdr (nreverse close-open-tags) "\n"))))
+
+
+;;;; Target
+
+(defun org-odt-target (target contents info)
+ "Transcode a TARGET object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((value (org-element-property :value target)))
+ (org-odt--target "" (org-export-solidify-link-text value))))
+
+
+;;;; Timestamp
+
+(defun org-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* ((raw-value (org-element-property :raw-value timestamp))
+ (type (org-element-property :type timestamp)))
+ (if (not org-odt-use-date-fields)
+ (let ((value (org-odt-plain-text
+ (org-timestamp-translate timestamp) info)))
+ (case (org-element-property :type timestamp)
+ ((active active-range)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgActiveTimestamp" value))
+ ((inactive inactive-range)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgInactiveTimestamp" value))
+ (otherwise value)))
+ (case type
+ (active
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgActiveTimestamp"
+ (format "&lt;%s&gt;" (org-odt--format-timestamp timestamp))))
+ (inactive
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgInactiveTimestamp"
+ (format "[%s]" (org-odt--format-timestamp timestamp))))
+ (active-range
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgActiveTimestamp"
+ (format "&lt;%s&gt;&#x2013;&lt;%s&gt;"
+ (org-odt--format-timestamp timestamp)
+ (org-odt--format-timestamp timestamp 'end))))
+ (inactive-range
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgInactiveTimestamp"
+ (format "[%s]&#x2013;[%s]"
+ (org-odt--format-timestamp timestamp)
+ (org-odt--format-timestamp timestamp 'end))))
+ (otherwise
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgDiaryTimestamp"
+ (org-odt-plain-text (org-timestamp-translate timestamp)
+ info)))))))
+
+
+;;;; Underline
+
+(defun org-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-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-odt--encode-plain-text
+ (org-element-property :value verbatim))))
+
+
+;;;; Verse Block
+
+(defun org-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-odt--encode-tabs-and-spaces contents))
+ ;; Surround it in a verse environment.
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgVerse" contents))
+
+
+
+;;; Filters
+
+;;;; LaTeX fragments
+
+(defun org-odt--translate-latex-fragments (tree backend info)
+ (let ((processing-type (plist-get info :with-latex))
+ (count 0))
+ ;; Normalize processing-type to one of dvipng, mathml or verbatim.
+ ;; If the desired converter is not available, force verbatim
+ ;; processing.
+ (case processing-type
+ ((t mathml)
+ (if (and (fboundp 'org-format-latex-mathml-available-p)
+ (org-format-latex-mathml-available-p))
+ (setq processing-type 'mathml)
+ (message "LaTeX to MathML converter not available.")
+ (setq processing-type 'verbatim)))
+ ((dvipng imagemagick)
+ (unless (and (org-check-external-command "latex" "" t)
+ (org-check-external-command
+ (if (eq processing-type 'dvipng) "dvipng" "convert") "" t))
+ (message "LaTeX to PNG converter not available.")
+ (setq processing-type 'verbatim)))
+ (otherwise
+ (message "Unknown LaTeX option. Forcing verbatim.")
+ (setq processing-type 'verbatim)))
+
+ ;; Store normalized value for later use.
+ (when (plist-get info :with-latex)
+ (plist-put info :with-latex processing-type))
+ (message "Formatting LaTeX using %s" processing-type)
+
+ ;; Convert `latex-fragment's and `latex-environment's.
+ (when (memq processing-type '(mathml dvipng imagemagick))
+ (org-element-map tree '(latex-fragment latex-environment)
+ (lambda (latex-*)
+ (incf count)
+ (let* ((latex-frag (org-element-property :value latex-*))
+ (input-file (plist-get info :input-file))
+ (cache-dir (file-name-directory input-file))
+ (cache-subdir (concat
+ (case processing-type
+ ((dvipng imagemagick) "ltxpng/")
+ (mathml "ltxmathml/"))
+ (file-name-sans-extension
+ (file-name-nondirectory input-file))))
+ (display-msg
+ (case processing-type
+ ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count))
+ (mathml (format "Creating MathML snippet %d..." count))))
+ ;; Get an Org-style link to PNG image or the MathML
+ ;; file.
+ (org-link
+ (let ((link (with-temp-buffer
+ (insert latex-frag)
+ (org-format-latex cache-subdir cache-dir
+ nil display-msg
+ nil nil processing-type)
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (if (not (string-match "file:\\([^]]*\\)" link))
+ (prog1 nil (message "LaTeX Conversion failed."))
+ link))))
+ (when org-link
+ ;; Conversion succeeded. Parse above Org-style link to a
+ ;; `link' object.
+ (let* ((link (car (org-element-map (with-temp-buffer
+ (org-mode)
+ (insert org-link)
+ (org-element-parse-buffer))
+ 'link 'identity))))
+ ;; Orphan the link.
+ (org-element-put-property link :parent nil)
+ (let* (
+ (replacement
+ (case (org-element-type latex-*)
+ ;; Case 1: LaTeX environment.
+ ;; Mimic a "standalone image or formula" by
+ ;; enclosing the `link' in a `paragraph'.
+ ;; Copy over original attributes, captions to
+ ;; the enclosing paragraph.
+ (latex-environment
+ (org-element-adopt-elements
+ (list 'paragraph
+ (list :style "OrgFormula"
+ :name (org-element-property :name
+ latex-*)
+ :caption (org-element-property :caption
+ latex-*)))
+ link))
+ ;; Case 2: LaTeX fragment.
+ ;; No special action.
+ (latex-fragment link))))
+ ;; Note down the object that link replaces.
+ (org-element-put-property replacement :replaces
+ (list (org-element-type latex-*)
+ (list :value latex-frag)))
+ ;; Replace now.
+ (org-element-set-element latex-* replacement))))))
+ info)))
+ tree)
+
+
+;;;; Description lists
+
+;; This translator is necessary to handle indented tables in a uniform
+;; manner. See comment in `org-odt--table'.
+
+(defun org-odt--translate-description-lists (tree backend info)
+ ;; OpenDocument has no notion of a description list. So simulate it
+ ;; using plain lists. Description lists in the exported document
+ ;; are typeset in the same manner as they are in a typical HTML
+ ;; document.
+ ;;
+ ;; Specifically, a description list like this:
+ ;;
+ ;; ,----
+ ;; | - term-1 :: definition-1
+ ;; | - term-2 :: definition-2
+ ;; `----
+ ;;
+ ;; gets translated in to the following form:
+ ;;
+ ;; ,----
+ ;; | - term-1
+ ;; | - definition-1
+ ;; | - term-2
+ ;; | - definition-2
+ ;; `----
+ ;;
+ ;; Further effect is achieved by fixing the OD styles as below:
+ ;;
+ ;; 1. Set the :type property of the simulated lists to
+ ;; `descriptive-1' and `descriptive-2'. Map these to list-styles
+ ;; that has *no* bullets whatsoever.
+ ;;
+ ;; 2. The paragraph containing the definition term is styled to be
+ ;; in bold.
+ ;;
+ (org-element-map tree 'plain-list
+ (lambda (el)
+ (when (equal (org-element-property :type el) 'descriptive)
+ (org-element-set-element
+ el
+ (apply 'org-element-adopt-elements
+ (list 'plain-list (list :type 'descriptive-1))
+ (mapcar
+ (lambda (item)
+ (org-element-adopt-elements
+ (list 'item (list :checkbox (org-element-property
+ :checkbox item)))
+ (list 'paragraph (list :style "Text_20_body_20_bold")
+ (or (org-element-property :tag item) "(no term)"))
+ (org-element-adopt-elements
+ (list 'plain-list (list :type 'descriptive-2))
+ (apply 'org-element-adopt-elements
+ (list 'item nil)
+ (org-element-contents item)))))
+ (org-element-contents el)))))
+ nil)
+ info)
+ tree)
+
+;;;; List tables
+
+;; Lists that are marked with attribute `:list-table' are called as
+;; list tables. They will be rendered as a table within the exported
+;; document.
+
+;; Consider an example. The following list table
+;;
+;; #+attr_odt :list-table t
+;; - Row 1
+;; - 1.1
+;; - 1.2
+;; - 1.3
+;; - Row 2
+;; - 2.1
+;; - 2.2
+;; - 2.3
+;;
+;; will be exported as though it were an Org table like the one show
+;; 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.
+;;
+;; A LIST-TABLE circumvents above problems.
+;;
+;; 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
+
+;; Translate lists to tables
+
+(defun org-odt--translate-list-tables (tree backend info)
+ (org-element-map tree 'plain-list
+ (lambda (l1-list)
+ (when (org-export-read-attribute :attr_odt l1-list :list-table)
+ ;; Replace list with table.
+ (org-element-set-element
+ l1-list
+ ;; Build replacement table.
+ (apply 'org-element-adopt-elements
+ (list 'table '(:type org :attr_odt (":style \"GriddedTable\"")))
+ (org-element-map l1-list 'item
+ (lambda (l1-item)
+ (let* ((l1-item-contents (org-element-contents l1-item))
+ l1-item-leading-text l2-list)
+ ;; Remove Level-2 list from the Level-item. It
+ ;; will be subsequently attached as table-cells.
+ (let ((cur l1-item-contents) prev)
+ (while (and cur (not (eq (org-element-type (car cur))
+ 'plain-list)))
+ (setq prev cur)
+ (setq cur (cdr cur)))
+ (when prev
+ (setcdr prev nil)
+ (setq l2-list (car cur)))
+ (setq l1-item-leading-text l1-item-contents))
+ ;; Level-1 items start a table row.
+ (apply 'org-element-adopt-elements
+ (list 'table-row (list :type 'standard))
+ ;; Leading text of level-1 item define
+ ;; the first table-cell.
+ (apply 'org-element-adopt-elements
+ (list 'table-cell nil)
+ l1-item-leading-text)
+ ;; Level-2 items define subsequent
+ ;; table-cells of the row.
+ (org-element-map l2-list 'item
+ (lambda (l2-item)
+ (apply 'org-element-adopt-elements
+ (list 'table-cell nil)
+ (org-element-contents l2-item)))
+ info nil 'item))))
+ info nil 'item))))
+ nil)
+ info)
+ tree)
+
+
+;;; Interactive functions
+
+(defun org-odt-create-manifest-file-entry (&rest args)
+ (push args org-odt-manifest-file-entries))
+
+(defun org-odt-write-manifest-file ()
+ (make-directory (concat org-odt-zip-dir "META-INF"))
+ (let ((manifest-file (concat org-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-odt-manifest-file-entry-tag
+ (nth 0 file-entry) (nth 1 file-entry) extra))))
+ org-odt-manifest-file-entries)
+ (insert "\n</manifest:manifest>"))))
+
+(defmacro org-odt--export-wrap (out-file &rest body)
+ `(let* ((--out-file ,out-file)
+ (out-file-type (file-name-extension --out-file))
+ (org-odt-xml-files '("META-INF/manifest.xml" "content.xml"
+ "meta.xml" "styles.xml"))
+ ;; Initialize temporary workarea. All files that end up in
+ ;; the exported document get parked/created here.
+ (org-odt-zip-dir (file-name-as-directory
+ (make-temp-file (format "%s-" out-file-type) t)))
+ (org-odt-manifest-file-entries nil)
+ (--cleanup-xml-buffers
+ (function
+ (lambda nil
+ ;; Kill all XML buffers.
+ (mapc (lambda (file)
+ (let ((buf (find-buffer-visiting
+ (concat org-odt-zip-dir file))))
+ (when buf
+ (with-current-buffer buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf)))))
+ org-odt-xml-files)
+ ;; Delete temporary directory and also other embedded
+ ;; files that get copied there.
+ (delete-directory org-odt-zip-dir t)))))
+ (condition-case 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-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-odt-zip-dir "mimetype"))
+ (org-odt-create-manifest-file-entry mimetype "/" "1.2"))
+ ;; Write out the manifest entries before zipping
+ (org-odt-write-manifest-file)
+ ;; Save all XML files.
+ (mapc (lambda (file)
+ (let ((buf (find-buffer-visiting
+ (concat org-odt-zip-dir file))))
+ (when buf
+ (with-current-buffer buf
+ ;; Prettify output if needed.
+ (when org-odt-prettify-xml
+ (indent-region (point-min) (point-max)))
+ (save-buffer 0)))))
+ org-odt-xml-files)
+ ;; Run zip.
+ (let* ((target --out-file)
+ (target-name (file-name-nondirectory 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-odt-zip-dir' as the current
+ ;; directory.
+ (with-current-buffer
+ (find-file-noselect (concat org-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)))
+ ;; Move the zip file from temporary work directory to
+ ;; user-mandated location.
+ (rename-file (concat org-odt-zip-dir target-name) target)
+ (message "Created %s" (expand-file-name 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-odt-preferred-output-format
+ (or (org-odt-convert target org-odt-preferred-output-format)
+ target))
+ ;; Case 2: No further conversion. Return exported
+ ;; OpenDocument file.
+ (t target))))
+ (error
+ ;; Cleanup work directory and work files.
+ (funcall --cleanup-xml-buffers)
+ (message "OpenDocument export failed: %s"
+ (error-message-string err))))))
+
+
+;;;; Export to OpenDocument formula
+
+;;;###autoload
+(defun org-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 depending on the value of
+`org-export-copy-to-kill-ring'."
+ (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-odt--export-wrap
+ filename
+ (let* ((buffer (progn
+ (require 'nxml-mode)
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect (concat org-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-p)
+ (org-kill-new (buffer-string))))))))
+
+;;;###autoload
+(defun org-odt-export-as-odf-and-open ()
+ "Export LaTeX fragment as OpenDocument formula and immediately open it.
+Use `org-odt-export-as-odf' to read LaTeX fragment and OpenDocument
+formula file."
+ (interactive)
+ (org-open-file (call-interactively 'org-odt-export-as-odf) 'system))
+
+
+;;;; Export to OpenDocument Text
+
+;;;###autoload
+(defun org-odt-export-to-odt (&optional async subtreep visible-only ext-plist)
+ "Export current buffer to a ODT file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".odt" subtreep)))
+ (if async
+ (org-export-async-start (lambda (f) (org-export-add-to-stack f 'odt))
+ `(expand-file-name
+ (org-odt--export-wrap
+ ,outfile
+ (let* ((org-odt-embedded-images-count 0)
+ (org-odt-embedded-formulas-count 0)
+ (org-odt-automatic-styles nil)
+ (org-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-odt-zip-dir "content.xml") t))))
+ (output (org-export-as
+ 'odt ,subtreep ,visible-only nil ,ext-plist)))
+ (with-current-buffer out-buf
+ (erase-buffer)
+ (insert output)))))))
+ (org-odt--export-wrap
+ outfile
+ (let* ((org-odt-embedded-images-count 0)
+ (org-odt-embedded-formulas-count 0)
+ (org-odt-automatic-styles nil)
+ (org-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 ((output (org-export-as 'odt subtreep visible-only nil ext-plist))
+ (out-buf (progn
+ (require 'nxml-mode)
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect
+ (concat org-odt-zip-dir "content.xml") t)))))
+ (with-current-buffer out-buf (erase-buffer) (insert output))))))))
+
+
+;;;; Convert between OpenDocument and other formats
+
+(defun org-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-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-odt-do-convert (in-file out-fmt &optional prefix-arg)
+ "Workhorse routine for `org-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-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 'system))
+ out-file)
+ (t
+ (message "Export to %s failed" out-file)
+ nil))))
+
+(defun org-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-odt-convert-processes' for CONVERTER-PROCESS and see
+`org-odt-convert-capabilities' for OUTPUT-FMT-ALIST."
+ (let* ((converter
+ (and org-odt-convert-process
+ (cadr (assoc-string org-odt-convert-process
+ org-odt-convert-processes t))))
+ (capabilities
+ (and org-odt-convert-process
+ (cadr (assoc-string org-odt-convert-process
+ org-odt-convert-processes t))
+ org-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-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-odt-do-reachable-formats in-fmt))))
+ l))
+
+(defun org-odt-convert-read-params ()
+ "Return IN-FILE and OUT-FMT params for `org-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-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-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-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-odt-convert-read-params) current-prefix-arg))
+ (org-odt-do-convert in-file out-fmt prefix-arg))
+
+;;; Library Initializations
+
+(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)
+
+(provide 'ox-odt)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-odt.el ends here
diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el
new file mode 100644
index 0000000000..41798b3e12
--- /dev/null
+++ b/lisp/org/ox-org.el
@@ -0,0 +1,255 @@
+;;; ox-org.el --- Org Back-End for Org Export Engine
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <[email protected]>
+;; Keywords: org, wp
+
+;; 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 an Org back-end for Org exporter.
+;;
+;; It introduces two interactive functions, `org-org-export-as-org'
+;; and `org-org-export-to-org', which export, respectively, to
+;; a temporary buffer and to a file.
+;;
+;; A publishing function is also provided: `org-org-publish-to-org'.
+
+;;; Code:
+(require 'ox)
+(declare-function htmlize-buffer "htmlize" (&optional buffer))
+
+(defgroup org-export-org nil
+ "Options for exporting Org mode files to Org."
+ :tag "Org Export Org"
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(define-obsolete-variable-alias
+ 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4")
+(defcustom org-org-htmlized-css-url nil
+ "URL pointing to the CSS defining colors for htmlized Emacs buffers.
+Normally when creating an htmlized version of an Org buffer,
+htmlize will create the 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-org-export-as-org' will include a link to this URL if the
+setting of `org-html-htmlize-output-type' is 'css."
+ :group 'org-export-org
+ :type '(choice
+ (const :tag "Don't include external stylesheet link" nil)
+ (string :tag "URL or local href")))
+
+(org-export-define-backend 'org
+ '((babel-call . org-org-identity)
+ (bold . org-org-identity)
+ (center-block . org-org-identity)
+ (clock . org-org-identity)
+ (code . org-org-identity)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (diary-sexp . org-org-identity)
+ (drawer . org-org-identity)
+ (dynamic-block . org-org-identity)
+ (entity . org-org-identity)
+ (example-block . org-org-identity)
+ (fixed-width . org-org-identity)
+ (footnote-definition . org-org-identity)
+ (footnote-reference . org-org-identity)
+ (headline . org-org-headline)
+ (horizontal-rule . org-org-identity)
+ (inline-babel-call . org-org-identity)
+ (inline-src-block . org-org-identity)
+ (inlinetask . org-org-identity)
+ (italic . org-org-identity)
+ (item . org-org-identity)
+ (keyword . org-org-keyword)
+ (latex-environment . org-org-identity)
+ (latex-fragment . org-org-identity)
+ (line-break . org-org-identity)
+ (link . org-org-identity)
+ (node-property . org-org-identity)
+ (paragraph . org-org-identity)
+ (plain-list . org-org-identity)
+ (planning . org-org-identity)
+ (property-drawer . org-org-identity)
+ (quote-block . org-org-identity)
+ (quote-section . org-org-identity)
+ (radio-target . org-org-identity)
+ (section . org-org-identity)
+ (special-block . org-org-identity)
+ (src-block . org-org-identity)
+ (statistics-cookie . org-org-identity)
+ (strike-through . org-org-identity)
+ (subscript . org-org-identity)
+ (superscript . org-org-identity)
+ (table . org-org-identity)
+ (table-cell . org-org-identity)
+ (table-row . org-org-identity)
+ (target . org-org-identity)
+ (timestamp . org-org-identity)
+ (underline . org-org-identity)
+ (verbatim . org-org-identity)
+ (verse-block . org-org-identity))
+ :menu-entry
+ '(?O "Export to Org"
+ ((?O "As Org buffer" org-org-export-as-org)
+ (?o "As Org file" org-org-export-to-org)
+ (?v "As Org file and open"
+ (lambda (a s v b)
+ (if a (org-org-export-to-org t s v b)
+ (org-open-file (org-org-export-to-org nil s v b))))))))
+
+(defun org-org-identity (blob contents info)
+ "Transcode BLOB element or object back into Org syntax.
+CONTENTS is its contents, as a string or nil. INFO is ignored."
+ (org-export-expand blob contents t))
+
+(defun org-org-headline (headline contents info)
+ "Transcode HEADLINE element back into Org syntax.
+CONTENTS is its contents, as a string or nil. INFO is ignored."
+ (unless (plist-get info :with-todo-keywords)
+ (org-element-put-property headline :todo-keyword nil))
+ (unless (plist-get info :with-tags)
+ (org-element-put-property headline :tags nil))
+ (unless (plist-get info :with-priority)
+ (org-element-put-property headline :priority nil))
+ (org-element-put-property headline :level
+ (org-export-get-relative-level headline info))
+ (org-element-headline-interpreter headline contents))
+
+(defun org-org-keyword (keyword contents info)
+ "Transcode KEYWORD element back into Org syntax.
+CONTENTS is nil. INFO is ignored. This function ignores
+keywords targeted at other export back-ends."
+ (unless (member (org-element-property :key keyword)
+ (mapcar
+ (lambda (block-cons)
+ (and (eq (cdr block-cons) 'org-element-export-block-parser)
+ (car block-cons)))
+ org-element-block-name-alist))
+ (org-element-keyword-interpreter keyword nil)))
+
+;;;###autoload
+(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist)
+ "Export current buffer to an Org buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+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.
+
+Export is done in a buffer named \"*Org ORG Export*\", which will
+be displayed when `org-export-show-temporary-export-buffer' is
+non-nil."
+ (interactive)
+ (org-export-to-buffer 'org "*Org ORG Export*"
+ async subtreep visible-only nil ext-plist (lambda () (org-mode))))
+
+;;;###autoload
+(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist)
+ "Export current buffer to an org file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return output file name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".org" subtreep)))
+ (org-export-to-file 'org outfile
+ async subtreep visible-only nil ext-plist)))
+
+;;;###autoload
+(defun org-org-publish-to-org (plist filename pub-dir)
+ "Publish an org file to org.
+
+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-publish-org-to 'org filename ".org" plist pub-dir)
+ (when (plist-get plist :htmlized-source)
+ (require 'htmlize)
+ (require 'ox-html)
+ (let* ((org-inhibit-startup t)
+ (htmlize-output-type 'css)
+ (html-ext (concat "." (or (plist-get plist :html-extension)
+ org-html-extension "html")))
+ (visitingp (find-buffer-visiting filename))
+ (work-buffer (or visitingp (find-file filename)))
+ newbuf)
+ (font-lock-fontify-buffer)
+ (show-all)
+ (org-show-block-all)
+ (setq newbuf (htmlize-buffer))
+ (with-current-buffer newbuf
+ (when org-org-htmlized-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-org-htmlized-css-url) t t)))
+ (write-file (concat pub-dir (file-name-nondirectory filename) html-ext)))
+ (kill-buffer newbuf)
+ (unless visitingp (kill-buffer work-buffer)))
+ (set-buffer-modified-p nil)))
+
+
+(provide 'ox-org)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-org.el ends here
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
new file mode 100644
index 0000000000..67a57fa38f
--- /dev/null
+++ b/lisp/org/ox-publish.el
@@ -0,0 +1,1238 @@
+;;; ox-publish.el --- Publish Related Org Mode Files as a Website
+;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+
+;; Author: David O'Toole <[email protected]>
+;; 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.
+;;
+;; ox-publish.el can do the following:
+;;
+;; + Publish all one's Org files to a given export back-end
+;; + 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 'ox)
+
+
+
+;;; Variables
+
+(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. Each back-end may define its
+ own (i.e. `org-latex-publish-to-pdf',
+ `org-html-publish-to-html'). May 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-date `org-export-with-date'
+ :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-inlinetasks `org-export-with-inlinetasks'
+ :with-latex `org-export-with-latex'
+ :with-priority `org-export-with-priority'
+ :with-smart-quotes `org-export-with-smart-quotes'
+ :with-special-strings `org-export-with-special-strings'
+ :with-statistics-cookies' `org-export-with-statistics-cookies'
+ :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-planning `org-export-with-planning'
+ :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-publish-current-project' or `org-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-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 property control the creation of a concept index.
+
+ `:makeindex'
+
+ Create a concept index. The file containing the index has to
+ be called \"theindex.org\". If it doesn't exist in the
+ project, it will be generated. Contents of the index are
+ stored in the file \"theindex.inc\", which can be included in
+ \"theindex.org\".
+
+Other properties affecting publication.
+
+ `:body-only'
+
+ Set this to t to publish only the body of the documents."
+ :group 'org-export-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-export-publish
+ :type 'boolean)
+
+(defcustom org-publish-timestamp-directory
+ (convert-standard-filename "~/.org-timestamps/")
+ "Name of directory in which to store publishing timestamps."
+ :group 'org-export-publish
+ :type 'directory)
+
+(defcustom org-publish-list-skipped-files t
+ "Non-nil means show message about files *not* published."
+ :group 'org-export-publish
+ :type 'boolean)
+
+(defcustom org-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-publish-project-alist', using `:sitemap-sort-files'."
+ :group 'org-export-publish
+ :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-export-publish
+ :type 'symbol)
+
+(defcustom org-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-publish-project-alist', using `:sitemap-ignore-case'."
+ :group 'org-export-publish
+ :type 'boolean)
+
+(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
+ "Format for printing a date in the sitemap.
+See `format-time-string' for allowed formatters."
+ :group 'org-export-publish
+ :type 'string)
+
+(defcustom org-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-publish-sitemap-date-format'."
+ :group 'org-export-publish
+ :type 'string)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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)
+ "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-publish-use-timestamps-flag) t
+ (org-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-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))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 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 (delete-dups (delq nil rtn)))))
+
+(defvar org-publish-sitemap-sort-files)
+(defvar org-publish-sitemap-sort-folders)
+(defvar org-publish-sitemap-ignore-case)
+(defvar org-publish-sitemap-requested)
+(defvar org-publish-sitemap-date-format)
+(defvar org-publish-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-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
+ ;; First we sort files:
+ (when org-publish-sitemap-sort-files
+ (case org-publish-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-publish-sitemap-ignore-case
+ (not (string-lessp (upcase B) (upcase A)))
+ (not (string-lessp B A))))))
+ ((anti-chronologically 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 (eq org-publish-sitemap-sort-files 'chronologically) (<= A B)
+ (>= A B)))))))
+ ;; Directory-wise wins:
+ (when org-publish-sitemap-sort-folders
+ ;; a is directory, b not:
+ (cond
+ ((and (file-directory-p a) (not (file-directory-p b)))
+ (setq retval (equal org-publish-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-publish-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)))))
+ (let ((all-files (if (not recurse) (directory-files base-dir t match)
+ ;; If RECURSE is non-nil, we want all files
+ ;; matching MATCH and sub-directories.
+ (org-remove-if-not
+ (lambda (file)
+ (or (file-directory-p file)
+ (and match (string-match match file))))
+ (directory-files base-dir t)))))
+ (if (not org-publish-sitemap-requested) all-files
+ (sort all-files 'org-publish-compare-directory-files)))))
+
+(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-publish-sitemap-requested
+ (plist-get project-plist :auto-sitemap))
+ (sitemap-filename
+ (or (plist-get project-plist :sitemap-filename) "sitemap.org"))
+ (org-publish-sitemap-sort-folders
+ (if (plist-member project-plist :sitemap-sort-folders)
+ (plist-get project-plist :sitemap-sort-folders)
+ org-publish-sitemap-sort-folders))
+ (org-publish-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-publish-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-publish-sitemap-sort-folders' has an accepted
+ ;; value.
+ (unless (memq org-publish-sitemap-sort-folders '(first last))
+ (setq org-publish-sitemap-sort-folders nil))
+
+ (setq org-publish-temp-files nil)
+ (if org-publish-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)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Tools for publishing functions in back-ends
+
+(defun org-publish-org-to (backend filename extension plist &optional 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.
+
+Optional argument PUB-DIR, when non-nil is the publishing
+directory.
+
+Return output file name."
+ (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t))
+ ;; Check if a buffer visiting FILENAME is already open.
+ (let* ((org-inhibit-startup t)
+ (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 nil body-p
+ ;; Add `org-publish-collect-numbering' and
+ ;; `org-publish-collect-index' to final output
+ ;; filters. The latter isn't dependent on
+ ;; `:makeindex', since we want to keep it up-to-date
+ ;; in cache anyway.
+ (org-combine-plists
+ plist
+ `(:filter-final-output
+ ,(cons 'org-publish-collect-numbering
+ (cons 'org-publish-collect-index
+ (plist-get plist :filter-final-output))))))))
+ ;; Remove opened buffer in the process.
+ (unless visitingp (kill-buffer work-buffer)))))
+
+(defun org-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-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)
+ (error "No publishing function chosen")))
+ (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-publish-sitemap-date-format
+ (or (plist-get project-plist :sitemap-date-format)
+ org-publish-sitemap-date-format))
+ (org-publish-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))
+ (theindex
+ (expand-file-name "theindex.org"
+ (plist-get project-plist :base-directory))))
+ (when preparation-function (run-hooks 'preparation-function))
+ (if sitemap-p (funcall sitemap-function project sitemap-filename))
+ ;; Publish all files from PROJECT excepted "theindex.org". Its
+ ;; publishing will be deferred until "theindex.inc" is
+ ;; populated.
+ (dolist (file files)
+ (unless (equal file theindex)
+ (org-publish-file file project t)))
+ ;; Populate "theindex.inc", if needed, and publish
+ ;; "theindex.org".
+ (when (plist-get project-plist :makeindex)
+ (org-publish-index-generate-theindex
+ project (plist-get project-plist :base-directory))
+ (org-publish-file theindex 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
+ (let ((org-inhibit-startup t))
+ (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-publish-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-publish-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* ((org-inhibit-startup t)
+ (visiting (find-buffer-visiting file))
+ (buffer (or visiting (find-file-noselect file))))
+ (with-current-buffer buffer
+ (org-mode)
+ (let ((title
+ (let ((property (plist-get (org-export-get-environment) :title)))
+ (if property (org-element-interpret-data property)
+ (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.
+This function assumes FILE is either a directory or an Org file.
+If FILE is an Org file and provides a DATE keyword use it. In
+any other case use the file system's modification time. Return
+time in `current-time' format."
+ (if (file-directory-p file) (nth 5 (file-attributes file))
+ (let* ((visiting (find-buffer-visiting file))
+ (file-buf (or visiting (find-file-noselect file nil)))
+ (date (plist-get
+ (with-current-buffer file-buf
+ (let ((org-inhibit-startup t)) (org-mode))
+ (org-export-get-environment))
+ :date)))
+ (unless visiting (kill-buffer file-buf))
+ ;; DATE is either a timestamp object or a secondary string. If it
+ ;; is a timestamp or if the secondary string contains a timestamp,
+ ;; convert it to internal format. Otherwise, use FILE
+ ;; modification time.
+ (cond ((eq (org-element-type date) 'timestamp)
+ (org-time-string-to-time (org-element-interpret-data date)))
+ ((let ((ts (and (consp date) (assq 'timestamp date))))
+ (and ts
+ (let ((value (org-element-interpret-data ts)))
+ (and (org-string-nw-p value)
+ (org-time-string-to-time value))))))
+ ((file-exists-p file) (nth 5 (file-attributes file)))
+ (t (error "No such file: \"%s\"" file))))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Interactive publishing functions
+
+;;;###autoload
+(defalias 'org-publish-project 'org-publish)
+
+;;;###autoload
+(defun org-publish (project &optional force async)
+ "Publish PROJECT.
+
+PROJECT is either a project name, as a string, or a project
+alist (see `org-publish-project-alist' variable).
+
+When optional argument FORCE is non-nil, force publishing all
+files in PROJECT. With a non-nil optional argument ASYNC,
+publishing will be done asynchronously, in another process."
+ (interactive
+ (list
+ (assoc (org-icompleting-read
+ "Publish project: "
+ org-publish-project-alist nil t)
+ org-publish-project-alist)
+ current-prefix-arg))
+ (let ((project-alist (if (not (stringp project)) (list project)
+ ;; If this function is called in batch mode,
+ ;; project is still a string here.
+ (list (assoc project org-publish-project-alist)))))
+ (if async
+ (org-export-async-start 'ignore
+ `(let ((org-publish-use-timestamps-flag
+ (if ',force nil ,org-publish-use-timestamps-flag)))
+ (org-publish-projects ',project-alist)))
+ (save-window-excursion
+ (let* ((org-publish-use-timestamps-flag
+ (if force nil org-publish-use-timestamps-flag)))
+ (org-publish-projects project-alist))))))
+
+;;;###autoload
+(defun org-publish-all (&optional force async)
+ "Publish all projects.
+With prefix argument FORCE, remove all files in the timestamp
+directory and force publishing all projects. With a non-nil
+optional argument ASYNC, publishing will be done asynchronously,
+in another process."
+ (interactive "P")
+ (if async
+ (org-export-async-start 'ignore
+ `(progn
+ (when ',force (org-publish-remove-all-timestamps))
+ (let ((org-publish-use-timestamps-flag
+ (if ',force nil ,org-publish-use-timestamps-flag)))
+ (org-publish-projects ',org-publish-project-alist))))
+ (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 async)
+ "Publish the current file.
+With prefix argument FORCE, force publish the file. When
+optional argument ASYNC is non-nil, publishing will be done
+asynchronously, in another process."
+ (interactive "P")
+ (let ((file (buffer-file-name (buffer-base-buffer))))
+ (if async
+ (org-export-async-start 'ignore
+ `(let ((org-publish-use-timestamps-flag
+ (if ',force nil ,org-publish-use-timestamps-flag)))
+ (org-publish-file ,file)))
+ (save-window-excursion
+ (let ((org-publish-use-timestamps-flag
+ (if force nil org-publish-use-timestamps-flag)))
+ (org-publish-file file))))))
+
+;;;###autoload
+(defun org-publish-current-project (&optional force async)
+ "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 (buffer-base-buffer)) 'up)))
+ (if project (org-publish project force async)
+ (error "File %s is not part of any known project"
+ (buffer-file-name (buffer-base-buffer)))))))
+
+
+
+;;; Index generation
+
+(defun org-publish-collect-index (output backend info)
+ "Update index for a file in cache.
+
+OUTPUT is the output from transcoding current file. BACKEND is
+the back-end that was used for transcoding. INFO is a plist
+containing publishing and export 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 a reference to the headline, if any, containing the
+original index keyword. When non-nil, this reference is a cons
+cell. Its CAR is a symbol among `id', `custom-id' and `name' and
+its CDR is a string."
+ (let ((file (plist-get info :input-file)))
+ (org-publish-cache-set-file-property
+ file :index
+ (delete-dups
+ (org-element-map (plist-get info :parse-tree) 'keyword
+ (lambda (k)
+ (when (equal (org-element-property :key k) "INDEX")
+ (let ((parent (org-export-get-parent-headline k)))
+ (list (org-element-property :value k)
+ file
+ (cond
+ ((not parent) nil)
+ ((let ((id (org-element-property :ID parent)))
+ (and id (cons 'id id))))
+ ((let ((id (org-element-property :CUSTOM_ID parent)))
+ (and id (cons 'custom-id id))))
+ (t (cons 'name
+ ;; Remove statistics cookie.
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (org-element-property :raw-value parent)))))))))
+ info))))
+ ;; Return output unchanged.
+ output)
+
+(defun org-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-publish-get-base-files
+ project (plist-get (cdr project) :exclude)))
+ full-index)
+ ;; Compile full index and sort it alphabetically.
+ (dolist (file all-files
+ (setq full-index
+ (sort (nreverse full-index)
+ (lambda (a b) (string< (downcase (car a))
+ (downcase (car b)))))))
+ (let ((index (org-publish-cache-get-file-property file :index)))
+ (dolist (term index)
+ (unless (member term full-index) (push term full-index)))))
+ ;; Write "theindex.inc" in DIRECTORY.
+ (with-temp-file (expand-file-name "theindex.inc" directory)
+ (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 (if (equal entry last-entry) (1- (length entry))
+ (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.
+ (case (car target)
+ ('nil (format "file:%s" file))
+ (id (format "id:%s" (cdr target)))
+ (custom-id (format "file:%s::#%s" file (cdr target)))
+ (otherwise (format "file:%s::*%s" file (cdr target))))
+ ;; Description.
+ (car (last entry)))))
+ "\n"))))
+ (setq current-letter letter last-entry entry))))
+ ;; Create "theindex.org", if it doesn't exist yet, and provide
+ ;; a default index file.
+ (let ((index.org (expand-file-name "theindex.org" directory)))
+ (unless (file-exists-p index.org)
+ (with-temp-file index.org
+ (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n")))))))
+
+
+
+;;; External Fuzzy Links Resolution
+;;
+;; This part implements tools to resolve [[file.org::*Some headline]]
+;; links, where "file.org" belongs to the current project.
+
+(defun org-publish-collect-numbering (output backend info)
+ (org-publish-cache-set-file-property
+ (plist-get info :input-file) :numbering
+ (mapcar (lambda (entry)
+ (cons (org-split-string
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (org-element-property :raw-value (car entry))))
+ (cdr entry)))
+ (plist-get info :headline-numbering)))
+ ;; Return output unchanged.
+ output)
+
+(defun org-publish-resolve-external-fuzzy-link (file fuzzy)
+ "Return numbering for headline matching FUZZY search in FILE.
+
+Return value is a list of numbers, or nil. This function allows
+to resolve external fuzzy links like:
+
+ [[file.org::*fuzzy][description]"
+ (when org-publish-cache
+ (cdr (assoc (org-split-string
+ (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy))
+ (org-publish-cache-get-file-property
+ (expand-file-name file) :numbering nil t)))))
+
+
+
+;;; Caching functions
+
+(defun org-publish-write-cache-file (&optional free-cache)
+ "Write `org-publish-cache' to file.
+If FREE-CACHE, empty the cache."
+ (unless org-publish-cache
+ (error "`org-publish-write-cache-file' called, but no cache present"))
+
+ (let ((cache-file (org-publish-cache-get ":cache-file:")))
+ (unless cache-file
+ (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
+ (with-temp-file cache-file
+ (let (print-level print-length)
+ (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."
+
+ (unless 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))
+ (unless (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")
+ (when (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 non-nil if the file needs publishing. Also check if
+any included files have been more recently published, so that
+the file including them will be republished as well."
+ (unless org-publish-cache
+ (error
+ "`org-publish-cache-file-needs-publishing' called, but no cache present"))
+ (let* ((case-fold-search t)
+ (key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (pstamp (org-publish-cache-get key))
+ (org-inhibit-startup t)
+ (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-publish-cache-ctime-of-src included-file) t))))
+ (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)
+ (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."
+ (unless 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."
+ (unless 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 FILE 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 'ox-publish)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-publish.el ends here
diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el
new file mode 100644
index 0000000000..5967978456
--- /dev/null
+++ b/lisp/org/ox-texinfo.el
@@ -0,0 +1,1891 @@
+;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine
+
+;; Copyright (C) 2012, 2013 Jonathan Leech-Pepin
+;; Author: Jonathan Leech-Pepin <jonathan.leechpepin 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 library implements a Texinfo back-end for Org generic
+;; exporter.
+;;
+;; To test it, run
+;;
+;; M-: (org-export-to-buffer 'texinfo "*Test Texinfo*") RET
+;;
+;; in an Org mode buffer then switch to the buffer to see the Texinfo
+;; export. See ox.el for more details on how this exporter works.
+;;
+
+;; It introduces nine new buffer keywords: "TEXINFO_CLASS",
+;; "TEXINFO_FILENAME", "TEXINFO_HEADER", "TEXINFO_POST_HEADER",
+;; "TEXINFO_DIR_CATEGORY", "TEXINFO_DIR_TITLE", "TEXINFO_DIR_DESC"
+;; "SUBTITLE" and "SUBAUTHOR".
+
+;;
+;; It introduces 1 new headline property keywords:
+;; "TEXINFO_MENU_TITLE" for optional menu titles.
+;;
+;; To include inline code snippets (for example for generating @kbd{}
+;; and @key{} commands), the following export-snippet keys are
+;; accepted:
+;;
+;; texinfo
+;; info
+;;
+;; You can add them for export snippets via any of the below:
+;;
+;; (add-to-list 'org-export-snippet-translation-alist
+;; '("info" . "texinfo"))
+;;
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox)
+
+(defvar orgtbl-exp-regexp)
+
+
+
+;;; Define Back-End
+
+(org-export-define-backend 'texinfo
+ '((bold . org-texinfo-bold)
+ (center-block . org-texinfo-center-block)
+ (clock . org-texinfo-clock)
+ (code . org-texinfo-code)
+ (comment . org-texinfo-comment)
+ (comment-block . org-texinfo-comment-block)
+ (drawer . org-texinfo-drawer)
+ (dynamic-block . org-texinfo-dynamic-block)
+ (entity . org-texinfo-entity)
+ (example-block . org-texinfo-example-block)
+ (export-block . org-texinfo-export-block)
+ (export-snippet . org-texinfo-export-snippet)
+ (fixed-width . org-texinfo-fixed-width)
+ (footnote-definition . org-texinfo-footnote-definition)
+ (footnote-reference . org-texinfo-footnote-reference)
+ (headline . org-texinfo-headline)
+ (inline-src-block . org-texinfo-inline-src-block)
+ (inlinetask . org-texinfo-inlinetask)
+ (italic . org-texinfo-italic)
+ (item . org-texinfo-item)
+ (keyword . org-texinfo-keyword)
+ (line-break . org-texinfo-line-break)
+ (link . org-texinfo-link)
+ (paragraph . org-texinfo-paragraph)
+ (plain-list . org-texinfo-plain-list)
+ (plain-text . org-texinfo-plain-text)
+ (planning . org-texinfo-planning)
+ (property-drawer . org-texinfo-property-drawer)
+ (quote-block . org-texinfo-quote-block)
+ (quote-section . org-texinfo-quote-section)
+ (radio-target . org-texinfo-radio-target)
+ (section . org-texinfo-section)
+ (special-block . org-texinfo-special-block)
+ (src-block . org-texinfo-src-block)
+ (statistics-cookie . org-texinfo-statistics-cookie)
+ (subscript . org-texinfo-subscript)
+ (superscript . org-texinfo-superscript)
+ (table . org-texinfo-table)
+ (table-cell . org-texinfo-table-cell)
+ (table-row . org-texinfo-table-row)
+ (target . org-texinfo-target)
+ (template . org-texinfo-template)
+ (timestamp . org-texinfo-timestamp)
+ (verbatim . org-texinfo-verbatim)
+ (verse-block . org-texinfo-verse-block))
+ :export-block "TEXINFO"
+ :filters-alist
+ '((:filter-headline . org-texinfo-filter-section-blank-lines)
+ (:filter-section . org-texinfo-filter-section-blank-lines))
+ :menu-entry
+ '(?i "Export to Texinfo"
+ ((?t "As TEXI file" org-texinfo-export-to-texinfo)
+ (?i "As INFO file" org-texinfo-export-to-info)))
+ :options-alist
+ '((:texinfo-filename "TEXINFO_FILENAME" nil org-texinfo-filename t)
+ (:texinfo-class "TEXINFO_CLASS" nil org-texinfo-default-class t)
+ (:texinfo-header "TEXINFO_HEADER" nil nil newline)
+ (:texinfo-post-header "TEXINFO_POST_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)))
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-texinfo nil
+ "Options for exporting Org mode files to Texinfo."
+ :tag "Org Export Texinfo"
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-export)
+
+;;; Preamble
+
+(defcustom org-texinfo-filename nil
+ "Default filename for Texinfo output."
+ :group 'org-export-texinfo
+ :type '(string :tag "Export Filename"))
+
+(defcustom org-texinfo-coding-system nil
+ "Default document encoding for Texinfo output.
+
+If `nil' it will default to `buffer-file-coding-system'."
+ :group 'org-export-texinfo
+ :type 'coding-system)
+
+(defcustom org-texinfo-default-class "info"
+ "The default Texinfo class."
+ :group 'org-export-texinfo
+ :type '(string :tag "Texinfo class"))
+
+(defcustom org-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-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-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-texinfo-format-headline (todo todo-type priority text tags)
+ \"Default format function for a 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-texinfo
+ :type 'function)
+
+;;; Node listing (menu)
+
+(defcustom org-texinfo-node-description-column 32
+ "Column at which to start the description in the node
+ listings.
+
+If a node title is greater than this length, the description will
+be placed after the end of the title."
+ :group 'org-export-texinfo
+ :type 'integer)
+
+;;; Footnotes
+;;
+;; Footnotes are inserted directly
+
+;;; Timestamps
+
+(defcustom org-texinfo-active-timestamp-format "@emph{%s}"
+ "A printf format string to be applied to active timestamps."
+ :group 'org-export-texinfo
+ :type 'string)
+
+(defcustom org-texinfo-inactive-timestamp-format "@emph{%s}"
+ "A printf format string to be applied to inactive timestamps."
+ :group 'org-export-texinfo
+ :type 'string)
+
+(defcustom org-texinfo-diary-timestamp-format "@emph{%s}"
+ "A printf format string to be applied to diary timestamps."
+ :group 'org-export-texinfo
+ :type 'string)
+
+;;; Links
+
+(defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}"
+ "Format string for links with unknown path type."
+ :group 'org-export-texinfo
+ :type 'string)
+
+;;; Tables
+
+(defcustom org-texinfo-tables-verbatim nil
+ "When non-nil, tables are exported verbatim."
+ :group 'org-export-texinfo
+ :type 'boolean)
+
+(defcustom org-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-texinfo
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting")))
+
+(defcustom org-texinfo-def-table-markup "@samp"
+ "Default setting for @table environments.")
+
+;;; Text markup
+
+(defcustom org-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-texinfo
+ :type 'alist
+ :options '(bold code italic verbatim comment))
+
+;;; Drawers
+
+(defcustom org-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-texinfo-format-drawer-default \(name contents\)
+ \"Format a drawer element for Texinfo export.\"
+ contents\)"
+ :group 'org-export-texinfo
+ :type 'function)
+
+;;; Inlinetasks
+
+(defcustom org-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-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-texinfo
+ :type 'function)
+
+;;; Src blocks
+;;
+;; Src Blocks are example blocks, except for LISP
+
+;;; Compilation
+
+(defcustom org-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")))
+
+(defcustom org-texinfo-logfiles-extensions
+ '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr")
+ "The list of file extensions to consider as Texinfo logfiles.
+The logfiles will be remove if `org-texinfo-remove-logfiles' is
+non-nil."
+ :group 'org-export-texinfo
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-texinfo-remove-logfiles t
+ "Non-nil means remove the logfiles produced by compiling a Texinfo file.
+By default, logfiles are files with these extensions: .aux, .toc,
+.cp, .fn, .ky, .pg and .tp. To define the set of logfiles to remove,
+set `org-texinfo-logfiles-extensions'."
+ :group 'org-export-latex
+ :type 'boolean)
+
+
+;;; Constants
+(defconst org-texinfo-max-toc-depth 4
+ "Maximum depth for creation of detailed menu listings. Beyond
+ this depth Texinfo will not recognize the nodes and will cause
+ errors. Left as a constant in case this value ever changes.")
+
+(defconst org-texinfo-supported-coding-systems
+ '("US-ASCII" "UTF-8" "ISO-8859-15" "ISO-8859-1" "ISO-8859-2" "koi8-r" "koi8-u")
+ "List of coding systems supported by Texinfo, as strings.
+Specified coding system will be matched against these strings.
+If two strings share the same prefix (e.g. \"ISO-8859-1\" and
+\"ISO-8859-15\"), the most specific one has to be listed first.")
+
+
+;;; Internal Functions
+
+(defun org-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-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-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-texinfo--text-markup (text markup)
+ "Format TEXT depending on MARKUP text markup.
+See `org-texinfo-text-markup-alist' for details."
+ (let ((fmt (cdr (assq markup org-texinfo-text-markup-alist))))
+ (cond
+ ;; No format string: Return raw text.
+ ((not fmt) text)
+ ((eq 'verb fmt)
+ (let ((separator (org-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)))))
+
+(defun org-texinfo--get-node (headline info)
+ "Return node entry associated to HEADLINE.
+INFO is a plist used as a communication channel."
+ (let ((menu-title (org-export-get-alt-title headline info)))
+ (org-texinfo--sanitize-menu
+ (replace-regexp-in-string
+ "%" "%%"
+ (if menu-title (org-export-data menu-title info)
+ (org-texinfo--sanitize-headline
+ (org-element-property :title headline) info))))))
+
+;;; Headline sanitizing
+
+(defun org-texinfo--sanitize-headline (headline info)
+ "Remove all formatting from the text of a headline for use in
+ node and menu listing."
+ (mapconcat 'identity
+ (org-texinfo--sanitize-headline-contents headline info) " "))
+
+(defun org-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)) info))
+ ;; Has content and recurse into the content
+ ((org-element-contents contents)
+ (org-texinfo--sanitize-headline-contents
+ (org-element-contents contents) info)))))
+
+;;; Menu sanitizing
+
+(defun org-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-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-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-texinfo--generate-menu-list tree level info))
+ output text-menu)
+ (cond
+ (detailed
+ ;; Looping is done within the menu generation.
+ (setq text-menu (org-texinfo--generate-detailed menu level info)))
+ (t
+ (setq text-menu (org-texinfo--generate-menu-items menu info))))
+ (when text-menu
+ (setq output (org-texinfo--format-menu text-menu))
+ (mapconcat 'identity output "\n"))))
+
+(defun org-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 (min org-texinfo-max-toc-depth
+ (plist-get info :headline-levels))))
+ (when (> max-depth level)
+ (loop for headline in menu append
+ (let* ((title (org-texinfo--menu-headlines headline info))
+ ;; Create list of menu entries for the next level
+ (sublist (org-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-texinfo--generate-menu-items sublist info)
+ (append (list title)
+ (org-texinfo--generate-menu-items sublist info))
+ 'nil))
+ ;; Start the process over the next level down.
+ (recursion (org-texinfo--generate-detailed sublist (1+ level) info)))
+ (setq recursion (append submenu recursion))
+ recursion))))))
+
+(defun org-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."
+ (org-element-map tree 'headline
+ (lambda (head)
+ (and (= (org-export-get-relative-level head info) level)
+ ;; Do not take note of footnotes or copying headlines.
+ (not (org-element-property :COPYING head))
+ (not (org-element-property :footnote-section-p head))
+ ;; Collect headline.
+ head))
+ info))
+
+(defun org-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-texinfo--format-menu'."
+ (loop for headline in items collect
+ (let* ((menu-title (org-texinfo--sanitize-menu
+ (org-export-data
+ (org-export-get-alt-title headline info)
+ info)))
+ (title (org-texinfo--sanitize-menu
+ (org-texinfo--sanitize-headline
+ (org-element-property :title headline) info)))
+ (descr (org-export-data
+ (org-element-property :DESCRIPTION headline)
+ info))
+ (menu-entry (if (string= "" menu-title) title menu-title))
+ (len (length menu-entry))
+ (output (list len menu-entry descr)))
+ output)))
+
+(defun org-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-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-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 (output)
+ (setq output
+ (mapcar (lambda (name)
+ (let* ((title (nth 1 name))
+ (desc (nth 2 name))
+ (length (nth 0 name))
+ (column (max
+ ;;6 is "* " ":: " for inserted text
+ length
+ (-
+ org-texinfo-node-description-column
+ 6)))
+ (spacing (- column length)
+ ))
+ (if (> length -1)
+ (concat "* " title ":: "
+ (make-string spacing ?\s)
+ (if desc
+ (concat desc)))
+ (concat "\n" title "\n"))))
+ text-menu))
+ output))
+
+;;; Template
+
+(defun org-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))
+ (lang (org-export-data (plist-get info :language) info))
+ (texinfo-header (plist-get info :texinfo-header))
+ (texinfo-post-header (plist-get info :texinfo-post-header))
+ (subtitle (plist-get info :subtitle))
+ (subauthor (plist-get info :subauthor))
+ (class (plist-get info :texinfo-class))
+ (header (nth 1 (assoc class org-texinfo-classes)))
+ (copying
+ (org-element-map (plist-get info :parse-tree) 'headline
+ (lambda (hl) (and (org-element-property :COPYING hl) hl)) info t))
+ (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-texinfo-make-menu info 'main))
+ (detail-menu (org-texinfo-make-menu info 'detailed)))
+ (concat
+ ;; Header
+ header "\n"
+ "@c %**start of header\n"
+ ;; Filename and Title
+ "@setfilename " info-filename "\n"
+ "@settitle " title "\n"
+ ;; Coding system.
+ (format
+ "@documentencoding %s\n"
+ (catch 'coding-system
+ (let ((case-fold-search t)
+ (name (symbol-name (or org-texinfo-coding-system
+ buffer-file-coding-system))))
+ (dolist (system org-texinfo-supported-coding-systems "UTF-8")
+ (when (org-string-match-p (regexp-quote system) name)
+ (throw 'coding-system system))))))
+ "\n"
+ (format "@documentlanguage %s\n" lang)
+ "\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"
+
+ ;; Additional Header Options set by #+TEXINFO_POST_HEADER
+ (if texinfo-post-header
+ (concat "\n"
+ texinfo-post-header
+ "\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
+
+;;; Bold
+
+(defun org-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-texinfo--text-markup contents 'bold))
+
+;;; Center Block
+
+(defun org-texinfo-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist used
+as a communication channel."
+ contents)
+
+;;; Clock
+
+(defun org-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-texinfo-inactive-timestamp-format
+ (concat (org-translate-time
+ (org-element-property :raw-value
+ (org-element-property :value clock)))
+ (let ((time (org-element-property :duration clock)))
+ (and time (format " (%s)" time)))))
+ "@*"))
+
+;;; Code
+
+(defun org-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-texinfo--text-markup (org-element-property :value code) 'code))
+
+;;; Comment
+
+(defun org-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-texinfo--text-markup (org-element-property :value comment) 'comment))
+
+;;; Comment Block
+
+(defun org-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-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-texinfo-format-drawer-function)
+ (funcall org-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-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-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-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-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-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) 'texinfo)
+ (org-element-property :value export-snippet)))
+
+;;; Fixed Width
+
+(defun org-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-texinfo--sanitize-content
+ (org-element-property :value fixed-width)))))
+
+;;; Footnote Reference
+;;
+
+(defun org-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-texinfo-headline (headline contents info)
+ "Transcode a 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-texinfo-classes))
+ ;; Find the index type, if any
+ (index (org-element-property :INDEX headline))
+ ;; Check if it is an appendix
+ (appendix (org-element-property :APPENDIX headline))
+ ;; Retrieve headline text
+ (text (org-texinfo--sanitize-headline
+ (org-element-property :title headline) info))
+ ;; Create node info, to insert it before section formatting.
+ ;; Use custom menu title if present
+ (node (format "@node %s\n" (org-texinfo--get-node headline info)))
+ ;; 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-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-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)))
+ (cond
+ ;;If an index, always unnumbered
+ (index
+ (concat menu node (cdr sec) "\n%s"))
+ (appendix
+ (concat menu node (replace-regexp-in-string
+ "unnumbered"
+ "appendix"
+ (cdr sec)) "\n%s"))
+ ;; Otherwise number as needed.
+ (t
+ (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-texinfo--sanitize-content
+ (if (functionp org-texinfo-format-headline-function)
+ ;; User-defined formatting function.
+ (funcall org-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-texinfo--sanitize-content
+ (if (functionp org-texinfo-format-headline-function)
+ ;; User-defined formatting function.
+ (funcall org-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))))))))
+
+;;; Inline Src Block
+
+(defun org-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-texinfo--find-verb-separator code)))
+ (concat "@verb{" separator code separator "}")))
+
+;;; Inlinetask
+
+(defun org-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-texinfo-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ (if (functionp org-texinfo-format-inlinetask-function)
+ (funcall org-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-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-texinfo--text-markup contents 'italic))
+
+;;; Item
+
+(defun org-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"
+ (and contents (org-trim contents)) "\n")))
+
+;;; Keyword
+
+(defun org-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)))))
+
+;;; Line Break
+
+(defun org-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."
+ "@*\n")
+
+;;; Link
+
+(defun org-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")
+ (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 a 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 a headline. Use the headline as the NODE target
+ (headline
+ (format "@ref{%s,%s}"
+ (org-texinfo--get-node destination info)
+ (or desc "")))
+ (otherwise
+ (let ((path (org-export-solidify-link-text path)))
+ (if (not desc) (format "@ref{%s}" path)
+ (format "@ref{%s,,%s}" path desc)))))))
+ ((member type '("info"))
+ (let* ((info-path (split-string path "[:#]"))
+ (info-manual (car info-path))
+ (info-node (or (cadr info-path) "top"))
+ (title (or desc "")))
+ (format "@ref{%s,%s,,%s,}" info-node title info-manual)))
+ ((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 a headline. Use the headline as the NODE target
+ (headline
+ (format "@ref{%s,%s}"
+ (org-texinfo--get-node destination info)
+ (or desc "")))
+ (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-texinfo-link-with-unknown-path-format desc)))))
+
+
+;;; Menu
+
+(defun org-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)))
+ (cond
+ ;; Generate the main menu
+ ((eq level 'main) (org-texinfo--build-menu parse 1 info))
+ ;; Generate the detailed (recursive) menu
+ ((eq level 'detailed)
+ ;; Requires recursion
+ ;;(org-texinfo--build-detailed-menu parse top info)
+ (org-texinfo--build-menu parse 1 info 'detailed)))))
+
+;;; Paragraph
+
+(defun org-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-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-texinfo-def-table-markup))
+ (type (org-element-property :type plain-list))
+ (table-type (plist-get attr :table-type))
+ ;; Ensure valid texinfo table type.
+ (table-type (if (member table-type '("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-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."
+ ;; First protect @, { and }.
+ (let ((output (org-texinfo--sanitize-content text)))
+ ;; Activate smart quotes. Be sure to provide original TEXT string
+ ;; since OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output
+ (org-export-activate-smart-quotes output :texinfo info text)))
+ ;; LaTeX into @LaTeX{} and TeX into @TeX{}
+ (let ((case-fold-search nil)
+ (start 0))
+ (while (string-match "\\(\\(?:La\\)?TeX\\)" output start)
+ (setq output (replace-match
+ (format "@%s{}" (match-string 1 output)) nil t output)
+ start (match-end 0))))
+ ;; Convert special strings.
+ (when (plist-get info :with-special-strings)
+ (while (string-match (regexp-quote "...") output)
+ (setq output (replace-match "@dots{}" nil t output))))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" " @*\n" output)))
+ ;; Return value.
+ output))
+
+;;; Planning
+
+(defun org-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-texinfo-inactive-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value closed))))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "@strong{%s} " org-deadline-string)
+ (format org-texinfo-active-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value deadline))))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "@strong{%s} " org-scheduled-string)
+ (format org-texinfo-active-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value scheduled))))))))
+ " ")
+ "@*"))
+
+;;; Property Drawer
+
+(defun org-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-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-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-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-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
+
+(defun org-texinfo-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist used
+as a communication channel."
+ contents)
+
+;;; Src Block
+
+(defun org-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))
+ (src-contents (org-texinfo--sanitize-content
+ (org-export-format-code-default src-block info))))
+ (cond
+ ;; Case 1. Lisp Block
+ (lisp-p
+ (format "@lisp\n%s@end lisp"
+ src-contents))
+ ;; Case 2. Other blocks
+ (t
+ (format "@example\n%s@end example"
+ src-contents)))))
+
+;;; Statistics Cookie
+
+(defun org-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))
+
+;;; Subscript
+
+(defun org-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-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-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-texinfo-table--table.el-table' or
+;; `org-texinfo-table--org-table' functions, depending of the type of
+;; the table.
+;;
+;; `org-texinfo-table--align-string' is a subroutine used to build
+;; alignment string for Org tables.
+
+(defun org-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-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-texinfo-table--table.el-table table contents info))
+ ;; Case 3: Standard table.
+ (t (org-texinfo-table--org-table table contents info))))
+
+(defun org-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 (org-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-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-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-texinfo-table--table.el-table (table contents info)
+ "Returns nothing.
+
+Rather than return an invalid table, nothing is returned."
+ 'nil)
+
+;;; Table Cell
+
+(defun org-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-texinfo-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-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-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)
+ (let ((rowgroup-tag
+ (cond
+ ;; Case 1: Belongs to second or subsequent rowgroup.
+ ((not (= 1 (org-export-table-row-group table-row info)))
+ "@item ")
+ ;; 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)
+ "@headitem ")
+ ;; Case 3: Row is from first and only row group.
+ (t "@item "))))
+ (when (eq (org-element-property :type table-row) 'standard)
+ (concat rowgroup-tag contents "\n")))))
+
+;;; Target
+
+(defun org-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-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-texinfo-plain-text
+ (org-timestamp-translate timestamp) info)))
+ (case (org-element-property :type timestamp)
+ ((active active-range)
+ (format org-texinfo-active-timestamp-format value))
+ ((inactive inactive-range)
+ (format org-texinfo-inactive-timestamp-format value))
+ (t (format org-texinfo-diary-timestamp-format value)))))
+
+;;; Verbatim
+
+(defun org-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-texinfo--text-markup (org-element-property :value verbatim) 'verbatim))
+
+;;; Verse Block
+
+(defun org-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-texinfo-export-to-texinfo
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".texi" subtreep))
+ (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-to-file 'texinfo outfile
+ async subtreep visible-only body-only ext-plist)))
+
+(defun org-texinfo-export-to-info
+ (&optional async subtreep visible-only body-only ext-plist)
+ "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.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+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)
+ (let ((outfile (org-export-output-file-name ".texi" subtreep))
+ (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-to-file 'texinfo outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-texinfo-compile file)))))
+
+;;;###autoload
+(defun org-texinfo-publish-to-texinfo (plist filename pub-dir)
+ "Publish an org file to Texinfo.
+
+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-publish-org-to 'texinfo filename ".texi" plist pub-dir))
+
+;;;###autoload
+(defun org-texinfo-convert-region-to-texinfo ()
+ "Assume the current region has org-mode syntax, and convert it to Texinfo.
+This can be used in any buffer. For example, you can write an
+itemized list in org-mode syntax in an Texinfo buffer and use
+this command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'texinfo))
+
+(defun org-texinfo-compile (file)
+ "Compile a texinfo file.
+
+FILE is the name of the file being compiled. Processing is
+done through the command specified in `org-texinfo-info-process'.
+
+Return INFO file name or an error if it couldn't be produced."
+ (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
+ (full-name (file-truename file))
+ (out-dir (file-name-directory file))
+ ;; Properly set working directory for compilation.
+ (default-directory (if (file-name-absolute-p file)
+ (file-name-directory full-name)
+ default-directory))
+ errors)
+ (message (format "Processing Texinfo file %s..." file))
+ (save-window-excursion
+ (cond
+ ;; A function is provided: Apply it.
+ ((functionp org-texinfo-info-process)
+ (funcall org-texinfo-info-process (shell-quote-argument file)))
+ ;; 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-texinfo-info-process)
+ (let ((outbuf (get-buffer-create "*Org INFO Texinfo Output*")))
+ (mapc
+ (lambda (command)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base-name)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument full-name)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
+ org-texinfo-info-process)
+ ;; Collect standard errors from output buffer.
+ (setq errors (org-texinfo-collect-errors outbuf))))
+ (t (error "No valid command to process to Info")))
+ (let ((infofile (concat out-dir base-name ".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.
+ (when org-texinfo-remove-logfiles
+ (dolist (ext org-texinfo-logfiles-extensions)
+ (let ((file (concat out-dir base-name "." ext)))
+ (when (file-exists-p file) (delete-file file)))))
+ (message (concat "Process completed"
+ (if (not errors) "."
+ (concat " with errors: " errors)))))
+ ;; Return output file name.
+ infofile))))
+
+(defun org-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 sectioning]")))
+ (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 'ox-texinfo)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-texinfo.el ends here
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
new file mode 100644
index 0000000000..f7566945a8
--- /dev/null
+++ b/lisp/org/ox.el
@@ -0,0 +1,6208 @@
+;;; ox.el --- Generic Export Engine for Org Mode
+
+;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 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'.
+;; This function can also support specific buffer keywords, OPTION
+;; keyword's items and filters. Refer to function's 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
+;; following part of the file.
+;;
+;; Then, a wrapper macro for asynchronous export,
+;; `org-export-async-start', along with tools to display results. are
+;; given in the penultimate part.
+;;
+;; Eventually, a dispatcher (`org-export-dispatch') for standard
+;; back-ends is provided in the last one.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org-element)
+(require 'org-macro)
+(require 'ob-exp)
+
+(declare-function org-publish "ox-publish" (project &optional force async))
+(declare-function org-publish-all "ox-publish" (&optional force async))
+(declare-function
+ org-publish-current-file "ox-publish" (&optional force async))
+(declare-function org-publish-current-project "ox-publish"
+ (&optional force async))
+
+(defvar org-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-date nil "date" org-export-with-date)
+ (: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-latex nil "tex" org-export-with-latex)
+ (:with-planning nil "p" org-export-with-planning)
+ (:with-priority nil "pri" org-export-with-priority)
+ (:with-smart-quotes nil "'" org-export-with-smart-quotes)
+ (:with-special-strings nil "-" org-export-with-special-strings)
+ (:with-statistics-cookies nil "stat" org-export-with-statistics-cookies)
+ (: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 a 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 determines 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.
+
+Values set through 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 '("FILETAGS" "SETUPFILE" "OPTIONS")
+ "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-diary-sexp . org-export-filter-diary-sexp-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-node-property . org-export-filter-node-property-functions)
+ (:filter-options . org-export-filter-options-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.")
+
+(defvar org-export-async-debug nil
+ "Non-nil means asynchronous export process should leave data behind.
+
+This data is found in the appropriate \"*Org Export Process*\"
+buffer, and in files prefixed with \"org-export-process\" and
+located in `temporary-file-directory'.
+
+When non-nil, it will also set `debug-on-error' to a non-nil
+value in the external process.")
+
+(defvar org-export-stack-contents nil
+ "Record asynchronously generated export results and processes.
+This is an alist: its CAR is the source of the
+result (destination file or buffer for a finished process,
+original buffer for a running one) and its CDR is a list
+containing the back-end used, as a symbol, and either a process
+or the time at which it finished. It is used to build the menu
+from `org-export-stack'.")
+
+(defvar org-export--registered-backends nil
+ "List of backends currently available in the exporter.
+This variable is set with `org-export-define-backend' and
+`org-export-define-derived-backend' functions.")
+
+(defvar org-export-dispatch-last-action nil
+ "Last command called from the dispatcher.
+The value should be a list. Its CAR is the action, as a symbol,
+and its CDR is a list of export options.")
+
+(defvar org-export-dispatch-last-position (make-marker)
+ "The position where the last export command was created using the dispatcher.
+This marker will be used with `C-u C-c C-e' to make sure export repetition
+uses the same subtree if the previous command was restricted to a subtree.")
+
+;; For compatibility with Org < 8
+(defvar org-export-current-backend nil
+ "Name, if any, of the back-end used during an export process.
+
+Its value is a symbol such as `html', `latex', `ascii', or nil if
+the back-end is anonymous (see `org-export-create-backend') or if
+there is no export process in progress.
+
+It can be used to teach Babel blocks how to act differently
+according to the back-end used.")
+
+
+;;; 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 keyword,
+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 keyword,
+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 keyword,
+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-with-date t
+ "Non-nil means insert date in the exported document.
+This option can also be set with the OPTIONS keyword,
+e.g. \"date:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-date-timestamp-format nil
+ "Time-stamp format string to use for DATE keyword.
+
+The format string, when specified, only applies if date consists
+in a single time-stamp. Otherwise its value will be ignored.
+
+See `format-time-string' for details on how to build this
+string."
+ :group 'org-export-general
+ :type '(choice
+ (string :tag "Time-stamp format string")
+ (const :tag "No format string" nil)))
+
+(defcustom org-export-creator-string
+ (format "Emacs %s (Org mode %s)"
+ emacs-version
+ (if (fboundp 'org-version) (org-version) "unknown version"))
+ "Information about the creator of the document.
+This option can also be set on with the CREATOR keyword."
+ :group 'org-export-general
+ :type '(string :tag "Creator string"))
+
+(defcustom org-export-with-drawers '(not "LOGBOOK")
+ "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. If that list starts with `not', only
+drawers with such names will be ignored.
+
+This variable doesn't apply to properties drawers.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"d:nil\"."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "All drawers" t)
+ (const :tag "None" nil)
+ (repeat :tag "Selected drawers"
+ (string :tag "Drawer name"))
+ (list :tag "Ignored drawers"
+ (const :format "" not)
+ (repeat :tag "Specify names of drawers to ignore during export"
+ :inline t
+ (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 keyword,
+e.g. \"email:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-emphasize t
+ "Non-nil means interpret *word*, /word/, _word_ and +word+.
+
+If the export target supports emphasizing text, the word will be
+typeset in bold, italic, with an underline or strike-through,
+respectively.
+
+This option can also be set with the OPTIONS keyword,
+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 keyword,
+e.g. \"::nil\"."
+ :group 'org-export-general
+ :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 keyword,
+e.g. \"f:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-latex t
+ "Non-nil means process LaTeX environments and fragments.
+
+This option can also be set with the OPTIONS line,
+e.g. \"tex:verbatim\". Allowed values are:
+
+nil Ignore math snippets.
+`verbatim' Keep everything in verbatim.
+t Allow export of math snippets."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not process math in any way" nil)
+ (const :tag "Interpret math snippets" t)
+ (const :tag "Leave math verbatim" verbatim)))
+
+(defcustom org-export-headline-levels 3
+ "The last level which is still exported as a headline.
+
+Inferior levels will usually produce itemize or enumerate lists
+when exported, but back-end behaviour may differ.
+
+This option can also be set with the OPTIONS keyword,
+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',
+`org-export-smart-quotes-alist' and `org-export-dictionary'.
+This option can also be set with the LANGUAGE keyword."
+ :group 'org-export-general
+ :type '(string :tag "Language"))
+
+(defcustom org-export-preserve-breaks nil
+ "Non-nil means preserve all line breaks when exporting.
+This option can also be set with the OPTIONS keyword,
+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 keyword,
+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 keyword,
+e.g. \"inline:nil\"."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-export-with-planning nil
+ "Non-nil means include planning info in export.
+
+Planning info is the line containing either SCHEDULED:,
+DEADLINE:, CLOSED: time-stamps, or a combination of them.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"p:t\"."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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 keyword,
+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 keyword,
+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-smart-quotes nil
+ "Non-nil means activate smart quotes during export.
+This option can also be set with the OPTIONS keyword,
+e.g., \"':t\".
+
+When setting this to non-nil, you need to take care of
+using the correct Babel package when exporting to LaTeX.
+E.g., you can load Babel for french like this:
+
+#+LATEX_HEADER: \\usepackage[french]{babel}"
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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 UTF-8
+ -----+----------+--------+-------
+ \\- &shy; \\-
+ -- &ndash; -- –
+ --- &mdash; --- —
+ ... &hellip; \\ldots …
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"-:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-statistics-cookies t
+ "Non-nil means include statistics cookies in export.
+This option can also be set with the OPTIONS keyword,
+e.g. \"stat:nil\""
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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 keyword,
+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 keyword,
+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 keyword,
+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 keyword,
+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 ignore all tasks.
+list of keywords include tasks with these keywords.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"tasks:nil\"."
+ :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 keyword, 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 any of the following values:
+ t export all timestamps.
+ `active' export active timestamps only.
+ `inactive' export inactive timestamps only.
+ nil do not export timestamps
+
+This only applies to timestamps isolated in a paragraph
+containing only timestamps. Other timestamps are always
+exported.
+
+This option can also be set with the OPTIONS keyword, 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. This option
+can also be set with the OPTIONS keyword, e.g. \"todo:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-allow-bind-keywords nil
+ "Non-nil means BIND keywords can define local variable values.
+This is a potential security risk, which is why the default value
+is nil. You can also allow them through local buffer variables."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(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\" . \"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
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :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
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'coding-system)
+
+(defcustom org-export-copy-to-kill-ring 'if-interactive
+ "Should we push exported content to the kill ring?"
+ :group 'org-export-general
+ :version "24.3"
+ :type '(choice
+ (const :tag "Always" t)
+ (const :tag "When export is done interactively" if-interactive)
+ (const :tag "Never" nil)))
+
+(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-in-background nil
+ "Non-nil means export and publishing commands will run in background.
+Results from an asynchronous export are never displayed
+automatically. But you can retrieve them with \\[org-export-stack]."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-export-async-init-file user-init-file
+ "File used to initialize external export process.
+Value must be an absolute file name. It defaults to user's
+initialization file. Though, a specific configuration makes the
+process faster and the export more portable."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(file :must-match t))
+
+(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 (\"b\" when
+output is restricted to body only, \"s\" when it is restricted to
+the current subtree, \"v\" when only visible elements are
+considered for export, \"f\" when publishing functions should be
+passed the FORCE argument and \"a\" when the export should be
+asynchronous). Also, \[?] allows to switch back to standard
+mode."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+
+
+;;; Defining Back-ends
+;;
+;; An export back-end is a structure with `org-export-backend' type
+;; and `name', `parent', `transcoders', `options', `filters', `blocks'
+;; and `menu' slots.
+;;
+;; At the lowest level, a back-end is created with
+;; `org-export-create-backend' function.
+;;
+;; A named back-end can be registered with
+;; `org-export-register-backend' function. A registered back-end can
+;; later be referred to by its name, with `org-export-get-backend'
+;; function. Also, such a back-end can become the parent of a derived
+;; back-end from which slot values will be inherited by default.
+;; `org-export-derived-backend-p' can check if a given back-end is
+;; derived from a list of back-end names.
+;;
+;; `org-export-get-all-transcoders', `org-export-get-all-options' and
+;; `org-export-get-all-filters' return the full alist of transcoders,
+;; options and filters, including those inherited from ancestors.
+;;
+;; At a higher level, `org-export-define-backend' is the standard way
+;; to define an export back-end. If the new back-end is similar to
+;; a registered back-end, `org-export-define-derived-backend' may be
+;; used instead.
+;;
+;; Eventually `org-export-barf-if-invalid-backend' returns an error
+;; when a given back-end hasn't been registered yet.
+
+(defstruct (org-export-backend (:constructor org-export-create-backend)
+ (:copier nil))
+ name parent transcoders options filters blocks menu)
+
+(defun org-export-get-backend (name)
+ "Return export back-end named after NAME.
+NAME is a symbol. Return nil if no such back-end is found."
+ (catch 'found
+ (dolist (b org-export--registered-backends)
+ (when (eq (org-export-backend-name b) name)
+ (throw 'found b)))))
+
+(defun org-export-register-backend (backend)
+ "Register BACKEND as a known export back-end.
+BACKEND is a structure with `org-export-backend' type."
+ ;; Refuse to register an unnamed back-end.
+ (unless (org-export-backend-name backend)
+ (error "Cannot register a unnamed export back-end"))
+ ;; Refuse to register a back-end with an unknown parent.
+ (let ((parent (org-export-backend-parent backend)))
+ (when (and parent (not (org-export-get-backend parent)))
+ (error "Cannot use unknown \"%s\" back-end as a parent" parent)))
+ ;; Register dedicated export blocks in the parser.
+ (dolist (name (org-export-backend-blocks backend))
+ (add-to-list 'org-element-block-name-alist
+ (cons name 'org-element-export-block-parser)))
+ ;; If a back-end with the same name as BACKEND is already
+ ;; registered, replace it with BACKEND. Otherwise, simply add
+ ;; BACKEND to the list of registered back-ends.
+ (let ((old (org-export-get-backend (org-export-backend-name backend))))
+ (if old (setcar (memq old org-export--registered-backends) backend)
+ (push backend org-export--registered-backends))))
+
+(defun org-export-barf-if-invalid-backend (backend)
+ "Signal an error if BACKEND isn't defined."
+ (unless (org-export-backend-p backend)
+ (error "Unknown \"%s\" back-end: Aborting export" backend)))
+
+(defun org-export-derived-backend-p (backend &rest backends)
+ "Non-nil if BACKEND is derived from one of BACKENDS.
+BACKEND is an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. BACKENDS is constituted of symbols."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (catch 'exit
+ (while (org-export-backend-parent backend)
+ (when (memq (org-export-backend-name backend) backends)
+ (throw 'exit t))
+ (setq backend
+ (org-export-get-backend (org-export-backend-parent backend))))
+ (memq (org-export-backend-name backend) backends))))
+
+(defun org-export-get-all-transcoders (backend)
+ "Return full translation table for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. Return value is an alist where
+keys are element or object types, as symbols, and values are
+transcoders.
+
+Unlike to `org-export-backend-transcoders', this function
+also returns transcoders inherited from parent back-ends,
+if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((transcoders (org-export-backend-transcoders backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq transcoders
+ (append transcoders (org-export-backend-transcoders backend))))
+ transcoders)))
+
+(defun org-export-get-all-options (backend)
+ "Return export options for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. See `org-export-options-alist'
+for the shape of the return value.
+
+Unlike to `org-export-backend-options', this function also
+returns options inherited from parent back-ends, if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((options (org-export-backend-options backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq options (append options (org-export-backend-options backend))))
+ options)))
+
+(defun org-export-get-all-filters (backend)
+ "Return complete list of filters for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. Return value is an alist where
+keys are symbols and values lists of functions.
+
+Unlike to `org-export-backend-filters', this function also
+returns filters inherited from parent back-ends, if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((filters (org-export-backend-filters backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq filters (append filters (org-export-backend-filters backend))))
+ filters)))
+
+(defun org-export-define-backend (backend transcoders &rest body)
+ "Define a new back-end BACKEND.
+
+TRANSCODERS 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' (or `inner-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. A function associated to `template'
+will not be applied if export has option \"body-only\".
+A function associated to `inner-template' is always applied.
+
+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.
+
+ :menu-entry
+
+ Menu entry for the export dispatcher. It should be a list
+ like:
+
+ '(KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU)
+
+ where :
+
+ KEY is a free character selecting the back-end.
+
+ DESCRIPTION-OR-ORDINAL is either a string or a number.
+
+ If it is a string, is will be used to name the back-end in
+ its menu entry. If it is a number, the following menu will
+ be displayed as a sub-menu of the back-end with the same
+ KEY. Also, the number will be used to determine in which
+ order such sub-menus will appear (lowest first).
+
+ ACTION-OR-MENU is either a function or an alist.
+
+ If it is an action, it will be called with four
+ arguments (booleans): ASYNC, SUBTREEP, VISIBLE-ONLY and
+ BODY-ONLY. See `org-export-as' for further explanations on
+ some of them.
+
+ If it is an alist, associations should follow the
+ pattern:
+
+ '(KEY DESCRIPTION ACTION)
+
+ where KEY, DESCRIPTION and ACTION are described above.
+
+ Valid values include:
+
+ '(?m \"My Special Back-end\" my-special-export-function)
+
+ or
+
+ '(?l \"Export to LaTeX\"
+ \(?p \"As PDF file\" org-latex-export-to-pdf)
+ \(?o \"As PDF file and open\"
+ \(lambda (a s v b)
+ \(if a (org-latex-export-to-pdf t s v b)
+ \(org-open-file
+ \(org-latex-export-to-pdf nil s v b)))))))
+
+ or the following, which will be added to the previous
+ sub-menu,
+
+ '(?l 1
+ \((?B \"As TEX buffer (Beamer)\" org-beamer-export-as-latex)
+ \(?P \"As PDF file (Beamer)\" org-beamer-export-to-pdf)))
+
+ :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."
+ (declare (indent 1))
+ (let (blocks filters menu-entry options contents)
+ (while (keywordp (car body))
+ (case (pop body)
+ (:export-block (let ((names (pop body)))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
+ (:filters-alist (setq filters (pop body)))
+ (:menu-entry (setq menu-entry (pop body)))
+ (:options-alist (setq options (pop body)))
+ (t (pop body))))
+ (org-export-register-backend
+ (org-export-create-backend :name backend
+ :transcoders transcoders
+ :options options
+ :filters filters
+ :blocks blocks
+ :menu menu-entry))))
+
+(defun 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 a list of allowed filters.
+
+ :menu-entry
+
+ Menu entry for the export dispatcher. See
+ `org-export-define-backend' for more information about the
+ expected value.
+
+ :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 `latex' back-end with a custom template function:
+
+ \(org-export-define-derived-backend 'my-latex '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 (indent 2))
+ (let (blocks filters menu-entry options transcoders contents)
+ (while (keywordp (car body))
+ (case (pop body)
+ (:export-block (let ((names (pop body)))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
+ (:filters-alist (setq filters (pop body)))
+ (:menu-entry (setq menu-entry (pop body)))
+ (:options-alist (setq options (pop body)))
+ (:translate-alist (setq transcoders (pop body)))
+ (t (pop body))))
+ (org-export-register-backend
+ (org-export-create-backend :name child
+ :parent parent
+ :transcoders transcoders
+ :options options
+ :filters filters
+ :blocks blocks
+ :menu menu-entry))))
+
+
+
+;;; 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 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
+;;
+;; + `:export-options' :: List of export options available for current
+;; process.
+;; - category :: none
+;; - type :: list of symbols, among `subtree', `body-only' and
+;; `visible-only'.
+;;
+;; + `:exported-data' :: Hash table used for memoizing
+;; `org-export-data'.
+;; - category :: tree
+;; - type :: hash table
+;;
+;; + `:filetags' :: List of global tags for buffer. Used by
+;; `org-export-get-tags' to get tags with inheritance.
+;; - category :: option
+;; - type :: list of strings
+;;
+;; + `: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
+;;
+;; + `: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 `inner-template', `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-nil means clock keywords should be exported.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-creator' :: Non-nil 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-date' :: Non-nil means output should contain a date.
+;; - category :: option
+;; - type :. symbol (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. If that list starts with `not', drawer
+;; with these names will be skipped.
+;; - 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-latex' :: Non-nil means `latex-environment' elements and
+;; `latex-fragment' objects should appear in export output. When
+;; this property is set to `verbatim', they will be left as-is.
+;; - category :: option
+;; - type :: symbol (`verbatim', nil, t)
+;;
+;; + `:with-planning' :: 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-smart-quotes' :: Non-nil means activate smart quotes in
+;; plain text.
+;; - 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--list-bound-variables' collects bound variables
+;; along with their value in order to set them as buffer local
+;; variables later in the process.
+
+(defun org-export-get-environment (&optional backend subtreep ext-plist)
+ "Collect export options from the current buffer.
+
+Optional argument BACKEND is an export back-end, as returned by
+`org-export-create-backend'.
+
+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 since these must be set before
+ ;; global options are read.
+ (dolist (pair (org-export--list-bound-variables))
+ (org-set-local (car pair) (nth 1 pair)))
+ ;; Get and prioritize export options...
+ (org-combine-plists
+ ;; ... from global variables...
+ (org-export--get-global-options backend)
+ ;; ... from an external property list...
+ ext-plist
+ ;; ... from in-buffer settings...
+ (org-export--get-inbuffer-options backend)
+ ;; ... and from subtree, when appropriate.
+ (and subtreep (org-export--get-subtree-options backend))
+ ;; Eventually add misc. properties.
+ (list
+ :back-end
+ backend
+ :translate-alist (org-export-get-all-transcoders backend)
+ :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 (save-match-data (org-element-at-point))))
+ (when (eq (org-element-type def) 'footnote-definition)
+ (push
+ (cons (org-element-property :label def)
+ (let ((cbeg (org-element-property :contents-begin def)))
+ (when cbeg
+ (org-element--parse-elements
+ cbeg (org-element-property :contents-end def)
+ 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 ((link (org-element-context)))
+ (when (eq (org-element-type link) 'link)
+ (let* ((id (org-element-property :path link))
+ (file (org-id-find-id-file id)))
+ (when file
+ (push (cons id (file-relative-name file)) alist)))))))
+ alist))))
+
+(defun org-export--parse-option-keyword (options &optional backend)
+ "Parse an OPTIONS line and return values as a plist.
+Optional argument BACKEND is an export back-end, as returned by,
+e.g., `org-export-create-backend'. It specifies which back-end
+specific items to read, if any."
+ (let* ((all
+ ;; Priority is given to back-end specific options.
+ (append (and backend (org-export-get-all-options backend))
+ org-export-options-alist))
+ plist)
+ (dolist (option all)
+ (let ((property (car option))
+ (item (nth 2 option)))
+ (when (and item
+ (not (plist-member plist property))
+ (string-match (concat "\\(\\`\\|[ \t]\\)"
+ (regexp-quote item)
+ ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)")
+ options))
+ (setq plist (plist-put plist
+ property
+ (car (read-from-string
+ (match-string 2 options))))))))
+ plist))
+
+(defun org-export--get-subtree-options (&optional backend)
+ "Get export options in subtree at point.
+Optional argument BACKEND is an export back-end, as returned by,
+e.g., `org-export-create-backend'. It specifies back-end used
+for export. Return options as a plist."
+ ;; For each buffer keyword, create a 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 a heading.
+ (if (org-at-heading-p) (org-up-heading-safe) (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 (or (org-entry-get (point) "EXPORT_TITLE")
+ (progn (looking-at org-todo-line-regexp)
+ (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. TITLE keyword is excluded as it has
+ ;; been handled already.
+ (let ((seen '("TITLE")))
+ (mapc
+ (lambda (option)
+ (let ((property (car option))
+ (keyword (nth 1 option)))
+ (when (and keyword (not (member keyword seen)))
+ (let* ((subtree-prop (concat "EXPORT_" keyword))
+ ;; Export properties are not case-sensitive.
+ (value (let ((case-fold-search t))
+ (org-entry-get (point) subtree-prop))))
+ (push keyword seen)
+ (when (and value (not (plist-member plist property)))
+ (setq plist
+ (plist-put
+ plist
+ property
+ (cond
+ ;; Parse VALUE if required.
+ ((member keyword org-element-document-properties)
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword)))
+ ;; If BEHAVIOUR is `split' expected value is
+ ;; a list of strings, not a string.
+ ((eq (nth 4 option) 'split) (org-split-string value))
+ (t value)))))))))
+ ;; Look for both general keywords and back-end specific
+ ;; options, with priority given to the latter.
+ (append (and backend (org-export-get-all-options backend))
+ org-export-options-alist)))
+ ;; Return value.
+ plist)))
+
+(defun org-export--get-inbuffer-options (&optional backend)
+ "Return current buffer export options, as a plist.
+
+Optional argument BACKEND, when non-nil, is an export back-end,
+as returned by, e.g., `org-export-create-backend'. It specifies
+which back-end specific options should also be read in the
+process.
+
+Assume buffer is in Org mode. Narrowing, if any, is ignored."
+ (let* (plist
+ get-options ; For byte-compiler.
+ (case-fold-search t)
+ (options (append
+ ;; Priority is given to back-end specific options.
+ (and backend (org-export-get-all-options backend))
+ org-export-options-alist))
+ (regexp (format "^[ \t]*#\\+%s:"
+ (regexp-opt (nconc (delq nil (mapcar 'cadr options))
+ org-export-special-keywords))))
+ (find-properties
+ (lambda (keyword)
+ ;; Return all properties associated to KEYWORD.
+ (let (properties)
+ (dolist (option options properties)
+ (when (equal (nth 1 option) keyword)
+ (pushnew (car option) properties))))))
+ (get-options
+ (lambda (&optional files plist)
+ ;; Recursively read keywords in buffer. FILES is a list
+ ;; of files read so far. PLIST is the current property
+ ;; list obtained.
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward regexp 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)))
+ (cond
+ ;; Options in `org-export-special-keywords'.
+ ((equal key "SETUPFILE")
+ (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))
+ (let ((org-inhibit-startup t)) (org-mode))
+ (setq plist (funcall get-options
+ (cons file files) plist))))))
+ ((equal key "OPTIONS")
+ (setq plist
+ (org-combine-plists
+ plist
+ (org-export--parse-option-keyword val backend))))
+ ((equal key "FILETAGS")
+ (setq plist
+ (org-combine-plists
+ plist
+ (list :filetags
+ (org-uniquify
+ (append (org-split-string val ":")
+ (plist-get plist :filetags)))))))
+ (t
+ ;; Options in `org-export-options-alist'.
+ (dolist (property (funcall find-properties key))
+ (let ((behaviour (nth 4 (assq property options))))
+ (setq plist
+ (plist-put
+ plist property
+ ;; Handle value depending on specified
+ ;; BEHAVIOUR.
+ (case behaviour
+ (space
+ (if (not (plist-get plist property))
+ (org-trim val)
+ (concat (plist-get plist property)
+ " "
+ (org-trim val))))
+ (newline
+ (org-trim
+ (concat (plist-get plist property)
+ "\n"
+ (org-trim val))))
+ (split `(,@(plist-get plist property)
+ ,@(org-split-string val)))
+ ('t val)
+ (otherwise
+ (if (not (plist-member plist property)) val
+ (plist-get plist property))))))))))))))
+ ;; Return final value.
+ plist))))
+ ;; Read options in the current buffer.
+ (setq plist (funcall get-options
+ (and buffer-file-name (list buffer-file-name)) nil))
+ ;; Parse keywords specified in `org-element-document-properties'
+ ;; and return PLIST.
+ (dolist (keyword org-element-document-properties plist)
+ (dolist (property (funcall find-properties keyword))
+ (let ((value (plist-get plist property)))
+ (when (stringp value)
+ (setq plist
+ (plist-put plist property
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword))))))))))
+
+(defun org-export--get-buffer-attributes ()
+ "Return properties related to buffer attributes, as a plist."
+ ;; Store full path of input file name, or nil. For internal use.
+ (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (list :input-file visited-file
+ :title (if (not visited-file) (buffer-name (buffer-base-buffer))
+ (file-name-sans-extension
+ (file-name-nondirectory visited-file))))))
+
+(defun org-export--get-global-options (&optional backend)
+ "Return global export options as a plist.
+Optional argument BACKEND, if non-nil, is an export back-end, as
+returned by, e.g., `org-export-create-backend'. It specifies
+which back-end specific export options should also be read in the
+process."
+ (let (plist
+ ;; Priority is given to back-end specific options.
+ (all (append (and backend (org-export-get-all-options backend))
+ org-export-options-alist)))
+ (dolist (cell all plist)
+ (let ((prop (car cell))
+ (default-value (nth 3 cell)))
+ (unless (or (not default-value) (plist-member plist prop))
+ (setq plist
+ (plist-put
+ plist
+ prop
+ ;; Eval default value provided. If keyword is
+ ;; a member of `org-element-document-properties',
+ ;; 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 (member keyword org-element-document-properties)
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword))
+ value)))))))))))
+
+(defun org-export--list-bound-variables ()
+ "Return variables bound from BIND keywords in current buffer.
+Also look for BIND keywords in setup files. The return value is
+an alist where associations are (VARIABLE-NAME VALUE)."
+ (when org-export-allow-bind-keywords
+ (let* (collect-bind ; For byte-compiler.
+ (collect-bind
+ (lambda (files alist)
+ ;; Return an alist between variable names and their
+ ;; value. FILES is a list of setup files names read so
+ ;; far, used to avoid circular dependencies. ALIST is
+ ;; the alist collected so far.
+ (let ((case-fold-search t))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let ((val (org-element-property :value element)))
+ (if (equal (org-element-property :key element) "BIND")
+ (push (read (format "(%s)" val)) alist)
+ ;; Enter setup file.
+ (let ((file (expand-file-name
+ (org-remove-double-quotes val))))
+ (unless (member file files)
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)) (org-mode))
+ (insert (org-file-contents file 'noerror))
+ (setq alist
+ (funcall collect-bind
+ (cons file files)
+ alist))))))))))
+ alist)))))
+ ;; Return value in appropriate order of appearance.
+ (nreverse (funcall collect-bind nil nil)))))
+
+
+;;;; Tree Properties
+;;
+;; Tree properties are information 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 a 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.
+
+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
+ `(: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 (org-element-property :footnote-section-p blob))
+ (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 a headline and value is its
+associated numbering \(in the shape of a list of numbers\) or nil
+for a footnotes section."
+ (let ((numbering (make-vector org-export-max-depth 0)))
+ (org-element-map data 'headline
+ (lambda (headline)
+ (unless (org-element-property :footnote-section-p 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
+ ;; First find trees containing a select tag, if any.
+ (selected (org-export--selected-trees data options))
+ (walk-data
+ (lambda (data)
+ ;; Collect ignored elements or objects into IGNORE-LIST.
+ (let ((type (org-element-type data)))
+ (if (org-export--skip-p data options selected) (push data ignore)
+ (if (and (eq type 'headline)
+ (eq (plist-get options :with-archived-trees) 'headline)
+ (org-element-property :archivedp data))
+ ;; 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 data))
+ ;; Move into secondary string, if any.
+ (let ((sec-prop
+ (cdr (assq type org-element-secondary-value-alist))))
+ (when sec-prop
+ (mapc walk-data (org-element-property sec-prop data))))
+ ;; Move into recursive objects/elements.
+ (mapc walk-data (org-element-contents data))))))))
+ ;; Main call.
+ (funcall walk-data data)
+ ;; Return value.
+ ignore))
+
+(defun org-export--selected-trees (data info)
+ "Return list of headlines and inlinetasks with 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)
+ (let ((type (org-element-type data)))
+ (cond
+ ((memq type '(headline inlinetask))
+ (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 inlinetask)
+ 'identity)
+ selected-trees))
+ ;; If at a headline, continue searching in tree,
+ ;; recursively.
+ (when (eq type 'headline)
+ (mapc (lambda (el)
+ (funcall walk-data el (cons data genealogy)))
+ (org-element-contents data))))))
+ ((or (eq type 'org-data)
+ (memq type org-element-greater-elements))
+ (mapc (lambda (el) (funcall walk-data el 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 or inlinetasks belonging to
+a tree with a select tag."
+ (case (org-element-type blob)
+ (clock (not (plist-get options :with-clocks)))
+ (drawer
+ (let ((with-drawers-p (plist-get options :with-drawers)))
+ (or (not with-drawers-p)
+ (and (consp with-drawers-p)
+ ;; If `:with-drawers' value starts with `not', ignore
+ ;; every drawer whose name belong to that list.
+ ;; Otherwise, ignore drawers whose name isn't in that
+ ;; list.
+ (let ((name (org-element-property :drawer-name blob)))
+ (if (eq (car with-drawers-p) 'not)
+ (member-ignore-case name (cdr with-drawers-p))
+ (not (member-ignore-case name with-drawers-p))))))))
+ ((footnote-definition footnote-reference)
+ (not (plist-get options :with-footnotes)))
+ ((headline inlinetask)
+ (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
+ (and (eq (org-element-type blob) 'inlinetask)
+ (not (plist-get options :with-inlinetasks)))
+ ;; 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))))))))
+ ((latex-environment latex-fragment) (not (plist-get options :with-latex)))
+ (planning (not (plist-get options :with-planning)))
+ (statistics-cookie (not (plist-get options :with-statistics-cookies)))
+ (table-cell
+ (and (org-export-table-has-special-column-p
+ (org-export-get-parent-table blob))
+ (not (org-export-get-previous-element blob options))))
+ (table-row (org-export-table-row-is-special-p blob options))
+ (timestamp
+ ;; `:with-timestamps' only applies to isolated timestamps
+ ;; objects, i.e. timestamp objects in a paragraph containing only
+ ;; timestamps and whitespaces.
+ (when (let ((parent (org-export-get-parent-element blob)))
+ (and (memq (org-element-type parent) '(paragraph verse-block))
+ (not (org-element-map parent
+ (cons 'plain-text
+ (remq 'timestamp org-element-all-objects))
+ (lambda (obj)
+ (or (not (stringp obj)) (org-string-nw-p obj)))
+ options t))))
+ (case (plist-get options :with-timestamps)
+ ('nil t)
+ (active
+ (not (memq (org-element-property :type blob) '(active active-range))))
+ (inactive
+ (not (memq (org-element-property :type blob)
+ '(inactive inactive-range)))))))))
+
+
+;;; 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 transcoders.
+;;
+;; It is possible to modify locally the back-end used by
+;; `org-export-data' or even use a temporary back-end by using
+;; `org-export-data-with-backend'.
+;;
+;; 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)))
+ (or (and (functionp transcoder)
+ (funcall transcoder data nil info))
+ ;; Export snippets never return a nil value so
+ ;; that white spaces following them are never
+ ;; ignored.
+ (and (eq type 'export-snippet) ""))))
+ ;; 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-data-with-backend (data backend info)
+ "Convert DATA into BACKEND format.
+
+DATA is an element, an object, a secondary string or a string.
+BACKEND is a symbol. INFO is a plist used as a communication
+channel.
+
+Unlike to `org-export-with-backend', this function will
+recursively convert DATA using BACKEND translation table."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-data
+ data
+ ;; Set-up a new communication channel with translations defined in
+ ;; BACKEND as the translate table and a new hash table for
+ ;; memoization.
+ (org-combine-plists
+ info
+ (list :back-end backend
+ :translate-alist (org-export-get-all-transcoders backend)
+ ;; Size of the hash table is reduced since this function
+ ;; will probably be used on small trees.
+ :exported-data (make-hash-table :test 'eq :size 401)))))
+
+(defun org-export--interpret-p (blob info)
+ "Non-nil if element or object BLOB should be interpreted during export.
+If nil, BLOB will appear as raw 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...
+ ((bold italic strike-through underline)
+ (plist-get info :with-emphasize))
+ ;; ... fixed-width areas.
+ (fixed-width (plist-get info :with-fixed-width))
+ ;; ... LaTeX environments and fragments...
+ ((latex-environment latex-fragment)
+ (let ((with-latex-p (plist-get info :with-latex)))
+ (and with-latex-p (not (eq with-latex-p 'verbatim)))))
+ ;; ... 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 &optional with-affiliated)
+ "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.
+
+When optional argument WITH-AFFILIATED is non-nil, add affiliated
+keywords before output."
+ (let ((type (org-element-type blob)))
+ (concat (and with-affiliated (memq type org-element-all-elements)
+ (org-element--interpret-affiliated-keywords blob))
+ (funcall (intern (format "org-element-%s-interpreter" type))
+ 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 stores filters as an alist. Each association has a key
+;; among the following symbols and a function or a list of functions
+;; as value.
+;;
+;; - `:filter-options' applies to the property list containing export
+;; options. Unlike to other filters, functions in this list accept
+;; two arguments instead of three: the property list containing
+;; export options and the back-end. Users can set its value through
+;; `org-export-filter-options-functions' variable.
+;;
+;; - `:filter-parse-tree' applies directly to the complete parsed
+;; tree. 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. A 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, two hooks (`org-export-before-processing-hook' and
+;; `org-export-before-parsing-hook') are run at the beginning of the
+;; export process and just before parsing to allow for heavy structure
+;; modifications.
+
+
+;;;; Hooks
+
+(defvar org-export-before-processing-hook nil
+ "Hook run at the beginning of the export process.
+
+This is run before include keywords and macros are expanded and
+Babel code blocks executed, on a copy of the original buffer
+being exported. Visibility and narrowing are preserved. Point
+is at the beginning of the buffer.
+
+Every function in this hook will be called with one argument: the
+back-end currently used, as a symbol.")
+
+(defvar org-export-before-parsing-hook nil
+ "Hook run before parsing an export buffer.
+
+This is run after include keywords and macros have been expanded
+and Babel code blocks executed, on a copy of the original buffer
+being exported. Visibility and narrowing are preserved. Point
+is at the beginning of the buffer.
+
+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-options-functions nil
+ "List of functions applied to the export options.
+Each filter is called with two arguments: the export options, as
+a plist, and the back-end, as a symbol. It must return
+a property list containing export options.")
+
+(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-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.")
+
+(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.")
+
+
+;;;; Elements Filters
+
+(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-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-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-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-diary-sexp-functions nil
+ "List of functions applied to a transcoded diary-sexp.
+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-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-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-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-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-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-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-node-property-functions nil
+ "List of functions applied to a transcoded node-property.
+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-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-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-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's name 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
+ (let* ((backend (plist-get info :back-end))
+ (backend-name (and backend (org-export-backend-name backend))))
+ (dolist (filter filters value)
+ (let ((result (funcall filter value backend-name info)))
+ (cond ((not result) 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'
+ ;; and filters already in INFO (through ext-plist mechanism).
+ (mapc (lambda (p)
+ (let* ((prop (car p))
+ (info-value (plist-get info prop))
+ (default-value (symbol-value (cdr p))))
+ (setq plist
+ (plist-put plist prop
+ ;; Filters in INFO will be called
+ ;; before those user provided.
+ (append (if (listp info-value) info-value
+ (list info-value))
+ default-value)))))
+ org-export-filters-alist)
+ ;; Prepend back-end specific filters to that list.
+ (mapc (lambda (p)
+ ;; Single values get consed, lists are appended.
+ (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))))))))
+ (org-export-get-all-filters (plist-get info :back-end)))
+ ;; 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 derivative, `org-export-string-as'.
+;; `org-export--copy-to-kill-ring-p' determines if output of these
+;; function should be added to kill ring.
+;;
+;; 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 macros and include keywords are expanded and
+;; Babel blocks are executed, if appropriate.
+;; `org-export-with-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 a 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.
+;;
+;; `org-export-insert-default-template' is a command to insert
+;; a default template (or a back-end specific template) at point or in
+;; current subtree.
+
+(defun org-export-copy-buffer ()
+ "Return a copy of the current buffer.
+The copy preserves Org buffer-local variables, visibility and
+narrowing."
+ (let ((copy-buffer-fun (org-export--generate-copy-script (current-buffer)))
+ (new-buf (generate-new-buffer (buffer-name))))
+ (with-current-buffer new-buf
+ (funcall copy-buffer-fun)
+ (set-buffer-modified-p nil))
+ new-buf))
+
+(defmacro org-export-with-buffer-copy (&rest body)
+ "Apply BODY in a copy of the current buffer.
+The copy preserves local variables, visibility and contents of
+the original buffer. Point is at the beginning of the buffer
+when BODY is applied."
+ (declare (debug t))
+ (org-with-gensyms (buf-copy)
+ `(let ((,buf-copy (org-export-copy-buffer)))
+ (unwind-protect
+ (with-current-buffer ,buf-copy
+ (goto-char (point-min))
+ (progn ,@body))
+ (and (buffer-live-p ,buf-copy)
+ ;; Kill copy without confirmation.
+ (progn (with-current-buffer ,buf-copy
+ (restore-buffer-modified-p nil))
+ (kill-buffer ,buf-copy)))))))
+
+(defun org-export--generate-copy-script (buffer)
+ "Generate a function duplicating BUFFER.
+
+The copy will preserve local variables, visibility, contents and
+narrowing of the original buffer. If a region was active in
+BUFFER, contents will be narrowed to that region instead.
+
+The resulting function can be evaled at a later time, from
+another buffer, effectively cloning the original buffer there.
+
+The function assumes BUFFER's major mode is `org-mode'."
+ (with-current-buffer buffer
+ `(lambda ()
+ (let ((inhibit-modification-hooks t))
+ ;; Set major mode. Ignore `org-mode-hook' as it has been run
+ ;; already in BUFFER.
+ (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode))
+ ;; Copy specific buffer local variables and variables set
+ ;; through BIND keywords.
+ ,@(let ((bound-variables (org-export--list-bound-variables))
+ vars)
+ (dolist (entry (buffer-local-variables (buffer-base-buffer)) vars)
+ (when (consp entry)
+ (let ((var (car entry))
+ (val (cdr entry)))
+ (and (not (eq var 'org-font-lock-keywords))
+ (or (memq var
+ '(default-directory
+ buffer-file-name
+ buffer-file-coding-system))
+ (assq var bound-variables)
+ (string-match "^\\(org-\\|orgtbl-\\)"
+ (symbol-name var)))
+ ;; Skip unreadable values, as they cannot be
+ ;; sent to external process.
+ (or (not val) (ignore-errors (read (format "%S" val))))
+ (push `(set (make-local-variable (quote ,var))
+ (quote ,val))
+ vars))))))
+ ;; Whole buffer contents.
+ (insert
+ ,(org-with-wide-buffer
+ (buffer-substring-no-properties
+ (point-min) (point-max))))
+ ;; Narrowing.
+ ,(if (org-region-active-p)
+ `(narrow-to-region ,(region-beginning) ,(region-end))
+ `(narrow-to-region ,(point-min) ,(point-max)))
+ ;; Current position of point.
+ (goto-char ,(point))
+ ;; Overlays with invisible property.
+ ,@(let (ov-set)
+ (mapc
+ (lambda (ov)
+ (let ((invis-prop (overlay-get ov 'invisible)))
+ (when invis-prop
+ (push `(overlay-put
+ (make-overlay ,(overlay-start ov)
+ ,(overlay-end ov))
+ 'invisible (quote ,invis-prop))
+ ov-set))))
+ (overlays-in (point-min) (point-max)))
+ ov-set)))))
+
+;;;###autoload
+(defun org-export-as
+ (backend &optional subtreep visible-only body-only ext-plist)
+ "Transcode current Org buffer into BACKEND code.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
+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 surrounding template.
+
+Optional argument EXT-PLIST, when provided, is a property list
+with external parameters overriding Org default settings, but
+still inferior to file-local settings.
+
+Return code as a string."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-barf-if-invalid-backend backend)
+ (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))))
+ ;; Initialize communication channel with original buffer
+ ;; attributes, unavailable in its copy.
+ (let* ((org-export-current-backend (org-export-backend-name backend))
+ (info (org-combine-plists
+ (list :export-options
+ (delq nil
+ (list (and subtreep 'subtree)
+ (and visible-only 'visible-only)
+ (and body-only 'body-only))))
+ (org-export--get-buffer-attributes)))
+ tree)
+ ;; Update communication channel and get parse tree. Buffer
+ ;; isn't parsed directly. Instead, a temporary copy is
+ ;; created, where include keywords, macros are expanded and
+ ;; code blocks are evaluated.
+ (org-export-with-buffer-copy
+ ;; Run first hook with current back-end's name as argument.
+ (run-hook-with-args 'org-export-before-processing-hook
+ (org-export-backend-name backend))
+ (org-export-expand-include-keyword)
+ ;; Update macro templates since #+INCLUDE keywords might have
+ ;; added some new ones.
+ (org-macro-initialize-templates)
+ (org-macro-replace-all org-macro-templates)
+ (org-export-execute-babel-code)
+ ;; Update radio targets since keyword inclusion might have
+ ;; added some more.
+ (org-update-radio-target-regexp)
+ ;; Run last hook with current back-end's name as argument.
+ (goto-char (point-min))
+ (save-excursion
+ (run-hook-with-args 'org-export-before-parsing-hook
+ (org-export-backend-name backend)))
+ ;; Update communication channel with environment. Also
+ ;; install user's and developer's filters.
+ (setq info
+ (org-export-install-filters
+ (org-combine-plists
+ info (org-export-get-environment backend subtreep ext-plist))))
+ ;; Expand export-specific set of macros: {{{author}}},
+ ;; {{{date}}}, {{{email}}} and {{{title}}}. It must be done
+ ;; once regular macros have been expanded, since document
+ ;; keywords may contain one of them.
+ (org-macro-replace-all
+ (list (cons "author"
+ (org-element-interpret-data (plist-get info :author)))
+ (cons "date"
+ (org-element-interpret-data (plist-get info :date)))
+ ;; EMAIL is not a parsed keyword: store it as-is.
+ (cons "email" (or (plist-get info :email) ""))
+ (cons "title"
+ (org-element-interpret-data (plist-get info :title)))))
+ ;; Call options filters and update export options. We do not
+ ;; use `org-export-filter-apply-functions' here since the
+ ;; arity of such filters is different.
+ (let ((backend-name (org-export-backend-name backend)))
+ (dolist (filter (plist-get info :filter-options))
+ (let ((result (funcall filter info backend-name)))
+ (when result (setq info result)))))
+ ;; Parse buffer and call parse-tree filter on it.
+ (setq tree
+ (org-export-filter-apply-functions
+ (plist-get info :filter-parse-tree)
+ (org-element-parse-buffer nil visible-only) info))
+ ;; 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)))
+ ;; Eventually transcode TREE. Wrap the resulting string into
+ ;; a template.
+ (let* ((body (org-element-normalize-string
+ (or (org-export-data tree info) "")))
+ (inner-template (cdr (assq 'inner-template
+ (plist-get info :translate-alist))))
+ (full-body (if (not (functionp inner-template)) body
+ (funcall inner-template body info)))
+ (template (cdr (assq 'template
+ (plist-get info :translate-alist)))))
+ ;; Remove all text properties since they cannot be
+ ;; retrieved from an external process. Finally call
+ ;; final-output filter and return result.
+ (org-no-properties
+ (org-export-filter-apply-functions
+ (plist-get info :filter-final-output)
+ (if (or (not (functionp template)) body-only) full-body
+ (funcall template full-body info))
+ info))))))))
+
+;;;###autoload
+(defun org-export-string-as (string backend &optional body-only ext-plist)
+ "Transcode STRING into BACKEND code.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
+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.
+
+Return code as a string."
+ (with-temp-buffer
+ (insert string)
+ (let ((org-inhibit-startup t)) (org-mode))
+ (org-export-as backend nil nil body-only ext-plist)))
+
+;;;###autoload
+(defun org-export-replace-region-by (backend)
+ "Replace the active region by its export to BACKEND.
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end."
+ (if (not (org-region-active-p))
+ (user-error "No active region to replace")
+ (let* ((beg (region-beginning))
+ (end (region-end))
+ (str (buffer-substring beg end)) rpl)
+ (setq rpl (org-export-string-as str backend t))
+ (delete-region beg end)
+ (insert rpl))))
+
+;;;###autoload
+(defun org-export-insert-default-template (&optional backend subtreep)
+ "Insert all export keywords with default values at beginning of line.
+
+BACKEND is a symbol referring to the name of a registered export
+back-end, for which specific export options should be added to
+the template, or `default' for default template. When it is nil,
+the user will be prompted for a category.
+
+If SUBTREEP is non-nil, export configuration will be set up
+locally for the subtree through node properties."
+ (interactive)
+ (unless (derived-mode-p 'org-mode) (user-error "Not in an Org mode buffer"))
+ (when (and subtreep (org-before-first-heading-p))
+ (user-error "No subtree to set export options for"))
+ (let ((node (and subtreep (save-excursion (org-back-to-heading t) (point))))
+ (backend
+ (or backend
+ (intern
+ (org-completing-read
+ "Options category: "
+ (cons "default"
+ (mapcar (lambda (b)
+ (symbol-name (org-export-backend-name b)))
+ org-export--registered-backends))))))
+ options keywords)
+ ;; Populate OPTIONS and KEYWORDS.
+ (dolist (entry (cond ((eq backend 'default) org-export-options-alist)
+ ((org-export-backend-p backend)
+ (org-export-get-all-options backend))
+ (t (org-export-get-all-options
+ (org-export-get-backend backend)))))
+ (let ((keyword (nth 1 entry))
+ (option (nth 2 entry)))
+ (cond
+ (keyword (unless (assoc keyword keywords)
+ (let ((value
+ (if (eq (nth 4 entry) 'split)
+ (mapconcat 'identity (eval (nth 3 entry)) " ")
+ (eval (nth 3 entry)))))
+ (push (cons keyword value) keywords))))
+ (option (unless (assoc option options)
+ (push (cons option (eval (nth 3 entry))) options))))))
+ ;; Move to an appropriate location in order to insert options.
+ (unless subtreep (beginning-of-line))
+ ;; First get TITLE, DATE, AUTHOR and EMAIL if they belong to the
+ ;; list of available keywords.
+ (when (assoc "TITLE" keywords)
+ (let ((title
+ (or (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (and visited-file
+ (file-name-sans-extension
+ (file-name-nondirectory visited-file))))
+ (buffer-name (buffer-base-buffer)))))
+ (if (not subtreep) (insert (format "#+TITLE: %s\n" title))
+ (org-entry-put node "EXPORT_TITLE" title))))
+ (when (assoc "DATE" keywords)
+ (let ((date (with-temp-buffer (org-insert-time-stamp (current-time)))))
+ (if (not subtreep) (insert "#+DATE: " date "\n")
+ (org-entry-put node "EXPORT_DATE" date))))
+ (when (assoc "AUTHOR" keywords)
+ (let ((author (cdr (assoc "AUTHOR" keywords))))
+ (if subtreep (org-entry-put node "EXPORT_AUTHOR" author)
+ (insert
+ (format "#+AUTHOR:%s\n"
+ (if (not (org-string-nw-p author)) ""
+ (concat " " author)))))))
+ (when (assoc "EMAIL" keywords)
+ (let ((email (cdr (assoc "EMAIL" keywords))))
+ (if subtreep (org-entry-put node "EXPORT_EMAIL" email)
+ (insert
+ (format "#+EMAIL:%s\n"
+ (if (not (org-string-nw-p email)) ""
+ (concat " " email)))))))
+ ;; Then (multiple) OPTIONS lines. Never go past fill-column.
+ (when options
+ (let ((items
+ (mapcar
+ #'(lambda (opt) (format "%s:%S" (car opt) (cdr opt)))
+ (sort options (lambda (k1 k2) (string< (car k1) (car k2)))))))
+ (if subtreep
+ (org-entry-put
+ node "EXPORT_OPTIONS" (mapconcat 'identity items " "))
+ (while items
+ (insert "#+OPTIONS:")
+ (let ((width 10))
+ (while (and items
+ (< (+ width (length (car items)) 1) fill-column))
+ (let ((item (pop items)))
+ (insert " " item)
+ (incf width (1+ (length item))))))
+ (insert "\n")))))
+ ;; And the rest of keywords.
+ (dolist (key (sort keywords (lambda (k1 k2) (string< (car k1) (car k2)))))
+ (unless (member (car key) '("TITLE" "DATE" "AUTHOR" "EMAIL"))
+ (let ((val (cdr key)))
+ (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val)
+ (insert
+ (format "#+%s:%s\n"
+ (car key)
+ (if (org-string-nw-p val) (format " %s" val) "")))))))))
+
+(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)
+ (let ((element (save-match-data (org-element-at-point))))
+ (when (eq (org-element-type element) 'keyword)
+ (beginning-of-line)
+ ;; Extract arguments from keyword's value.
+ (let* ((value (org-element-property :value element))
+ (ind (org-get-indentation))
+ (file (and (string-match
+ "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
+ (prog1 (expand-file-name
+ (org-remove-double-quotes
+ (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) nil)
+ ((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
+ (org-escape-code-in-string
+ (org-export--prepare-file-contents file lines))))
+ (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
+ (org-escape-code-in-string
+ (org-export--prepare-file-contents file lines))))
+ (format "%s#+BEGIN_SRC %s\n%s%s#+END_SRC\n"
+ ind-str env contents ind-str))))
+ (t
+ (insert
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)) (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)
+ (let ((org-inhibit-startup t)) (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)
+ (let ((org-inhibit-startup t)) (org-mode)))
+ (org-with-limited-levels
+ (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 ?*)))))))))))
+ (org-element-normalize-string (buffer-string))))
+
+(defun org-export-execute-babel-code ()
+ "Execute every Babel code in the visible part of current buffer."
+ ;; Get a pristine copy of current buffer so Babel references can be
+ ;; properly resolved.
+ (let ((reference (org-export-copy-buffer)))
+ (unwind-protect (let ((org-current-export-file reference))
+ (org-babel-exp-process-buffer))
+ (kill-buffer reference))))
+
+(defun org-export--copy-to-kill-ring-p ()
+ "Return a non-nil value when output should be added to the kill ring.
+See also `org-export-copy-to-kill-ring'."
+ (if (eq org-export-copy-to-kill-ring 'if-interactive)
+ (not (or executing-kbd-macro noninteractive))
+ (eq org-export-copy-to-kill-ring t)))
+
+
+
+;;; 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.
+
+;;;; 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.
+;;
+;; Since captions can span over multiple lines and accept dual values,
+;; their internal representation is a bit tricky. Therefore,
+;; `org-export-get-caption' transparently returns a given element's
+;; caption as a secondary string.
+
+(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.
+
+All values will become strings except the empty string and
+\"nil\", which will become nil. Also, values containing only
+double quotes will be read as-is, which means that \"\" value
+will become the empty string."
+ (let* ((prepare-value
+ (lambda (str)
+ (save-match-data
+ (cond ((member str '(nil "" "nil")) nil)
+ ((string-match "^\"\\(\"+\\)?\"$" str)
+ (or (match-string 1 str) ""))
+ (t str)))))
+ (attributes
+ (let ((value (org-element-property attribute element)))
+ (when value
+ (let ((s (mapconcat 'identity value " ")) result)
+ (while (string-match
+ "\\(?:^\\|[ \t]+\\)\\(:[-a-zA-Z0-9_]+\\)\\([ \t]+\\|$\\)"
+ s)
+ (let ((value (substring s 0 (match-beginning 0))))
+ (push (funcall prepare-value value) result))
+ (push (intern (match-string 1 s)) result)
+ (setq s (substring s (match-end 0))))
+ ;; Ignore any string before first property with `cdr'.
+ (cdr (nreverse (cons (funcall prepare-value s) result))))))))
+ (if property (plist-get attributes property) attributes)))
+
+(defun org-export-get-caption (element &optional shortp)
+ "Return caption from ELEMENT as a secondary string.
+
+When optional argument SHORTP is non-nil, return short caption,
+as a secondary string, instead.
+
+Caption lines are separated by a white space."
+ (let ((full-caption (org-element-property :caption element)) caption)
+ (dolist (line full-caption (cdr caption))
+ (let ((cap (funcall (if shortp 'cdr 'car) line)))
+ (when cap
+ (setq caption (nconc (list " ") (copy-sequence cap) caption)))))))
+
+
+;;;; For Derived Back-ends
+;;
+;; `org-export-with-backend' is a function allowing to locally use
+;; another back-end to transcode some object or element. In a derived
+;; back-end, it may be used as a fall-back function once all specific
+;; cases have been treated.
+
+(defun org-export-with-backend (backend data &optional contents info)
+ "Call a transcoder from BACKEND on DATA.
+BACKEND is an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. DATA is an Org element, object, secondary
+string or string. CONTENTS, when non-nil, is the transcoded
+contents of DATA element, as a string. INFO, when non-nil, is
+the communication channel used for export, as a plist."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-barf-if-invalid-backend backend)
+ (let ((type (org-element-type data)))
+ (if (memq type '(nil org-data)) (error "No foreign transcoder available")
+ (let* ((all-transcoders (org-export-get-all-transcoders backend))
+ (transcoder (cdr (assq type all-transcoders))))
+ (if (not (functionp transcoder))
+ (error "No foreign transcoder available")
+ (funcall
+ transcoder data contents
+ (org-combine-plists
+ info (list :back-end backend
+ :translate-alist all-transcoders
+ :exported-data (make-hash-table :test 'eq :size 401)))))))))
+
+
+;;;; 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
+;; a 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. If no such
+definition can be found, return the \"DEFINITION NOT FOUND\"
+string."
+ (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)))
+ "DEFINITION NOT FOUND.")))
+
+(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.
+;;
+;; `org-export-get-tags', `org-export-get-category' and
+;; `org-export-get-node-property' extract useful information from an
+;; headline or a parent headline. They all handle inheritance.
+;;
+;; `org-export-get-alt-title' tries to retrieve an alternative title,
+;; as a secondary string, suitable for table of contents. It falls
+;; back onto default title.
+
+(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 inherited)
+ "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.
+
+When optional argument INHERITED is non-nil, tags can also be
+inherited from parent headlines and FILETAGS keywords."
+ (org-remove-if
+ (lambda (tag) (or (member tag (plist-get info :select-tags))
+ (member tag (plist-get info :exclude-tags))
+ (member tag tags)))
+ (if (not inherited) (org-element-property :tags element)
+ ;; Build complete list of inherited tags.
+ (let ((current-tag-list (org-element-property :tags element)))
+ (mapc
+ (lambda (parent)
+ (mapc
+ (lambda (tag)
+ (when (and (memq (org-element-type parent) '(headline inlinetask))
+ (not (member tag current-tag-list)))
+ (push tag current-tag-list)))
+ (org-element-property :tags parent)))
+ (org-export-get-genealogy element))
+ ;; Add FILETAGS keywords and return results.
+ (org-uniquify (append (plist-get info :filetags) current-tag-list))))))
+
+(defun org-export-get-node-property (property blob &optional inherited)
+ "Return node PROPERTY value for BLOB.
+
+PROPERTY is an upcase symbol (i.e. `:COOKIE_DATA'). BLOB is an
+element or object.
+
+If optional argument INHERITED is non-nil, the value can be
+inherited from a parent headline.
+
+Return value is a string or nil."
+ (let ((headline (if (eq (org-element-type blob) 'headline) blob
+ (org-export-get-parent-headline blob))))
+ (if (not inherited) (org-element-property property blob)
+ (let ((parent headline) value)
+ (catch 'found
+ (while parent
+ (when (plist-member (nth 1 parent) property)
+ (throw 'found (org-element-property property parent)))
+ (setq parent (org-element-property :parent parent))))))))
+
+(defun org-export-get-category (blob info)
+ "Return category for element or object BLOB.
+
+INFO is a plist used as a communication channel.
+
+CATEGORY is automatically inherited from a parent headline, from
+#+CATEGORY: keyword or created out of original file name. If all
+fail, the fall-back value is \"???\"."
+ (or (let ((headline (if (eq (org-element-type blob) 'headline) blob
+ (org-export-get-parent-headline blob))))
+ ;; Almost like `org-export-node-property', but we cannot trust
+ ;; `plist-member' as every headline has a `:CATEGORY'
+ ;; property, would it be nil or equal to "???" (which has the
+ ;; same meaning).
+ (let ((parent headline) value)
+ (catch 'found
+ (while parent
+ (let ((category (org-element-property :CATEGORY parent)))
+ (and category (not (equal "???" category))
+ (throw 'found category)))
+ (setq parent (org-element-property :parent parent))))))
+ (org-element-map (plist-get info :parse-tree) 'keyword
+ (lambda (kwd)
+ (when (equal (org-element-property :key kwd) "CATEGORY")
+ (org-element-property :value kwd)))
+ info 'first-match)
+ (let ((file (plist-get info :input-file)))
+ (and file (file-name-sans-extension (file-name-nondirectory file))))
+ "???"))
+
+(defun org-export-get-alt-title (headline info)
+ "Return alternative title for HEADLINE, as a secondary string.
+INFO is a plist used as a communication channel. If no optional
+title is defined, fall-back to the regular title."
+ (or (org-element-property :alt-title headline)
+ (org-element-property :title headline)))
+
+(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 Keywords
+;;
+;; `org-export-get-date' returns a date appropriate for the document
+;; to about to be exported. In particular, it takes care of
+;; `org-export-date-timestamp-format'.
+
+(defun org-export-get-date (info &optional fmt)
+ "Return date value for the current document.
+
+INFO is a plist used as a communication channel. FMT, when
+non-nil, is a time format string that will be applied on the date
+if it consists in a single timestamp object. It defaults to
+`org-export-date-timestamp-format' when nil.
+
+A proper date can be a secondary string, a string or nil. It is
+meant to be translated with `org-export-data' or alike."
+ (let ((date (plist-get info :date))
+ (fmt (or fmt org-export-date-timestamp-format)))
+ (cond ((not date) nil)
+ ((and fmt
+ (not (cdr date))
+ (eq (org-element-type (car date)) 'timestamp))
+ (org-timestamp-format (car date) fmt))
+ (t date))))
+
+
+;;;; 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>>) 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\". White spaces are not
+significant."
+ (let* ((raw-path (org-element-property :path link))
+ (match-title-p (eq (aref raw-path 0) ?*))
+ ;; Split PATH at white spaces so matches are space
+ ;; insensitive.
+ (path (org-split-string
+ (if match-title-p (substring raw-path 1) raw-path)))
+ ;; Cache for destinations that are not position dependent.
+ (link-cache
+ (or (plist-get info :resolve-fuzzy-link-cache)
+ (plist-get (setq info (plist-put info :resolve-fuzzy-link-cache
+ (make-hash-table :test 'equal)))
+ :resolve-fuzzy-link-cache)))
+ (cached (gethash path link-cache 'not-found)))
+ (cond
+ ;; Destination is not position dependent: use cached value.
+ ((and (not match-title-p) (not (eq cached 'not-found))) cached)
+ ;; First try to find a matching "<<path>>" unless user specified
+ ;; he was looking for a headline (path starts with a "*"
+ ;; character).
+ ((and (not match-title-p)
+ (let ((match (org-element-map (plist-get info :parse-tree) 'target
+ (lambda (blob)
+ (and (equal (org-split-string
+ (org-element-property :value blob))
+ path)
+ blob))
+ info 'first-match)))
+ (and match (puthash path match link-cache)))))
+ ;; Then try to find an element with a matching "#+NAME: path"
+ ;; affiliated keyword.
+ ((and (not match-title-p)
+ (let ((match (org-element-map (plist-get info :parse-tree)
+ org-element-all-elements
+ (lambda (el)
+ (let ((name (org-element-property :name el)))
+ (when (and name
+ (equal (org-split-string name) path))
+ el)))
+ info 'first-match)))
+ (and match (puthash path match link-cache)))))
+ ;; Last case: link either points to a 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. Statistics cookies
+ ;; are ignored.
+ (lambda (name data)
+ (org-element-map data 'headline
+ (lambda (headline)
+ (when (equal (org-split-string
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (org-element-property :raw-value headline)))
+ name)
+ headline))
+ info 'first-match)))))
+ ;; Search among headlines sharing an ancestor with link, from
+ ;; closest to farthest.
+ (catch 'exit
+ (mapc
+ (lambda (parent)
+ (let ((foundp (funcall find-headline path parent)))
+ (when foundp (throw 'exit foundp))))
+ (let ((parent-hl (org-export-get-parent-headline link)))
+ (if (not parent-hl) (list (plist-get info :parse-tree))
+ (cons parent-hl (org-export-get-genealogy parent-hl)))))
+ ;; No destination found: return nil.
+ (and (not match-title-p) (puthash path nil link-cache))))))))
+
+(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 (replace-regexp-in-string
+ "[ \r\t\n]+" " " (org-element-property :path link))))
+ (org-element-map (plist-get info :parse-tree) 'radio-target
+ (lambda (radio)
+ (and (eq (compare-strings
+ (replace-regexp-in-string
+ "[ \r\t\n]+" " " (org-element-property :value radio))
+ nil nil path nil nil t)
+ t)
+ radio))
+ info 'first-match)))
+
+
+;;;; 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 a 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."
+ ;; 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: A 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.
+ (code (replace-regexp-in-string
+ "\\`\\([ \t]*\n\\)+" ""
+ (replace-regexp-in-string
+ "\\([ \t]*\n\\)*[ \t]*\\'" "\n"
+ (org-element-property :value element))))
+ ;; 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")))
+ (if (null code-lines) ""
+ (let* ((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 a header.
+
+INFO is a plist used as a communication channel.
+
+A table has a header when it contains at least two row groups."
+ (let ((cache (or (plist-get info :table-header-cache)
+ (plist-get (setq info
+ (plist-put info :table-header-cache
+ (make-hash-table :test 'eq)))
+ :table-header-cache))))
+ (or (gethash table cache)
+ (let ((rowgroup 1) row-flag)
+ (puthash
+ table
+ (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 'first-match)
+ cache)))))
+
+(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 number, as an integer.
+
+INFO is a plist used as the communication channel.
+
+Return value is the group number, as an integer, or nil for
+special rows and rows separators. First group is also table's
+header."
+ (let ((cache (or (plist-get info :table-row-group-cache)
+ (plist-get (setq info
+ (plist-put info :table-row-group-cache
+ (make-hash-table :test 'eq)))
+ :table-row-group-cache))))
+ (cond ((gethash table-row cache))
+ ((eq (org-element-property :type table-row) 'rule) nil)
+ (t (let ((group 0) row-flag)
+ (org-element-map (org-export-get-parent table-row) 'table-row
+ (lambda (row)
+ (if (eq (org-element-property :type row) 'rule)
+ (setq row-flag nil)
+ (unless row-flag (incf group) (setq row-flag t)))
+ (when (eq table-row row) (puthash table-row group cache)))
+ info 'first-match))))))
+
+(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))
+ (table (org-export-get-parent row))
+ (cells (org-element-contents row))
+ (columns (length cells))
+ (column (- columns (length (memq table-cell cells))))
+ (cache (or (plist-get info :table-cell-width-cache)
+ (plist-get (setq info
+ (plist-put info :table-cell-width-cache
+ (make-hash-table :test 'eq)))
+ :table-cell-width-cache)))
+ (width-vector (or (gethash table cache)
+ (puthash table (make-vector columns 'empty) cache)))
+ (value (aref width-vector column)))
+ (if (not (eq value 'empty)) value
+ (let (cookie-width)
+ (dolist (row (org-element-contents table)
+ (aset width-vector column cookie-width))
+ (when (org-export-table-row-is-special-p row info)
+ ;; In a special row, try to find a width cookie at COLUMN.
+ (let* ((value (org-element-contents
+ (elt (org-element-contents row) column)))
+ (cookie (car value)))
+ ;; The following checks avoid expanding unnecessarily
+ ;; the cell with `org-export-data'.
+ (when (and value
+ (not (cdr value))
+ (stringp cookie)
+ (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" cookie)
+ (match-string 1 cookie))
+ (setq cookie-width
+ (string-to-number (match-string 1 cookie)))))))))))
+
+(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'."
+ ;; Load `org-table-number-fraction' and `org-table-number-regexp'.
+ (require 'org-table)
+ (let* ((row (org-export-get-parent table-cell))
+ (table (org-export-get-parent row))
+ (cells (org-element-contents row))
+ (columns (length cells))
+ (column (- columns (length (memq table-cell cells))))
+ (cache (or (plist-get info :table-cell-alignment-cache)
+ (plist-get (setq info
+ (plist-put info :table-cell-alignment-cache
+ (make-hash-table :test 'eq)))
+ :table-cell-alignment-cache)))
+ (align-vector (or (gethash table cache)
+ (puthash table (make-vector columns nil) cache))))
+ (or (aref align-vector column)
+ (let ((number-cells 0)
+ (total-cells 0)
+ cookie-align
+ previous-cell-number-p)
+ (dolist (row (org-element-contents (org-export-get-parent 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)
+ ;; Treat an empty cell as a number if it follows
+ ;; a number.
+ (if (not (or (string-match org-table-number-regexp value)
+ (and (string= value "") previous-cell-number-p)))
+ (setq previous-cell-number-p nil)
+ (setq previous-cell-number-p t)
+ (incf number-cells))))))
+ ;; Return value. Alignment specified by cookies has
+ ;; precedence over alignment deduced from cell's contents.
+ (aset align-vector
+ column
+ (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-row-number (table-row info)
+ "Return TABLE-ROW number.
+INFO is a plist used as a communication channel. Return value is
+zero-based and ignores separators. The function returns nil for
+special colums and separators."
+ (when (and (eq (org-element-property :type table-row) 'standard)
+ (not (org-export-table-row-is-special-p table-row info)))
+ (let ((number 0))
+ (org-element-map (org-export-get-parent-table table-row) 'table-row
+ (lambda (row)
+ (cond ((eq row table-row) number)
+ ((eq (org-element-property :type row) 'standard)
+ (incf number) nil)))
+ info 'first-match))))
+
+(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))
+ (row-number (org-export-table-row-number table-row info)))
+ (when row-number
+ (cons row-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.
+Footnote sections, if any, will be ignored."
+ (let ((limit (plist-get info :headline-levels)))
+ (setq n (if (wholenump n) (min n limit) limit))
+ (org-element-map (plist-get info :parse-tree) 'headline
+ #'(lambda (headline)
+ (unless (org-element-property :footnote-section-p headline)
+ (let ((level (org-export-get-relative-level headline info)))
+ (and (<= 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))
+
+
+;;;; Smart Quotes
+;;
+;; The main function for the smart quotes sub-system is
+;; `org-export-activate-smart-quotes', which replaces every quote in
+;; a given string from the parse tree with its "smart" counterpart.
+;;
+;; Dictionary for smart quotes is stored in
+;; `org-export-smart-quotes-alist'.
+;;
+;; Internally, regexps matching potential smart quotes (checks at
+;; string boundaries are also necessary) are defined in
+;; `org-export-smart-quotes-regexps'.
+
+(defconst org-export-smart-quotes-alist
+ '(("da"
+ ;; one may use: »...«, "...", ›...‹, or '...'.
+ ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
+ ;; LaTeX quotes require Babel!
+ (opening-double-quote :utf-8 "»" :html "&raquo;" :latex ">>"
+ :texinfo "@guillemetright{}")
+ (closing-double-quote :utf-8 "«" :html "&laquo;" :latex "<<"
+ :texinfo "@guillemetleft{}")
+ (opening-single-quote :utf-8 "›" :html "&rsaquo;" :latex "\\frq{}"
+ :texinfo "@guilsinglright{}")
+ (closing-single-quote :utf-8 "‹" :html "&lsaquo;" :latex "\\flq{}"
+ :texinfo "@guilsingleft{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("de"
+ (opening-double-quote :utf-8 "„" :html "&bdquo;" :latex "\"`"
+ :texinfo "@quotedblbase{}")
+ (closing-double-quote :utf-8 "“" :html "&ldquo;" :latex "\"'"
+ :texinfo "@quotedblleft{}")
+ (opening-single-quote :utf-8 "‚" :html "&sbquo;" :latex "\\glq{}"
+ :texinfo "@quotesinglbase{}")
+ (closing-single-quote :utf-8 "‘" :html "&lsquo;" :latex "\\grq{}"
+ :texinfo "@quoteleft{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("en"
+ (opening-double-quote :utf-8 "“" :html "&ldquo;" :latex "``" :texinfo "``")
+ (closing-double-quote :utf-8 "”" :html "&rdquo;" :latex "''" :texinfo "''")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("es"
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "“" :html "&ldquo;" :latex "``" :texinfo "``")
+ (closing-single-quote :utf-8 "”" :html "&rdquo;" :latex "''" :texinfo "''")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("fr"
+ (opening-double-quote :utf-8 "« " :html "&laquo;&nbsp;" :latex "\\og "
+ :texinfo "@guillemetleft{}@tie{}")
+ (closing-double-quote :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
+ :texinfo "@tie{}@guillemetright{}")
+ (opening-single-quote :utf-8 "« " :html "&laquo;&nbsp;" :latex "\\og "
+ :texinfo "@guillemetleft{}@tie{}")
+ (closing-single-quote :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
+ :texinfo "@tie{}@guillemetright{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("no"
+ ;; https://nn.wikipedia.org/wiki/Sitatteikn
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("nb"
+ ;; https://nn.wikipedia.org/wiki/Sitatteikn
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("nn"
+ ;; https://nn.wikipedia.org/wiki/Sitatteikn
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("sv"
+ ;; based on https://sv.wikipedia.org/wiki/Citattecken
+ (opening-double-quote :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
+ (closing-double-quote :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
+ (opening-single-quote :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ )
+ "Smart quotes translations.
+
+Alist whose CAR is a language string and CDR is an alist with
+quote type as key and a plist associating various encodings to
+their translation as value.
+
+A quote type can be any symbol among `opening-double-quote',
+`closing-double-quote', `opening-single-quote',
+`closing-single-quote' and `apostrophe'.
+
+Valid encodings include `:utf-8', `:html', `:latex' and
+`:texinfo'.
+
+If no translation is found, the quote character is left as-is.")
+
+(defconst org-export-smart-quotes-regexps
+ (list
+ ;; Possible opening quote at beginning of string.
+ "\\`\\([\"']\\)\\(\\w\\|\\s.\\|\\s_\\)"
+ ;; Possible closing quote at beginning of string.
+ "\\`\\([\"']\\)\\(\\s-\\|\\s)\\|\\s.\\)"
+ ;; Possible apostrophe at beginning of string.
+ "\\`\\('\\)\\S-"
+ ;; Opening single and double quotes.
+ "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\(?:\\w\\|\\s.\\|\\s_\\)"
+ ;; Closing single and double quotes.
+ "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\(?:\\s-\\|\\s)\\|\\s.\\)"
+ ;; Apostrophe.
+ "\\S-\\('\\)\\S-"
+ ;; Possible opening quote at end of string.
+ "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\'"
+ ;; Possible closing quote at end of string.
+ "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\'"
+ ;; Possible apostrophe at end of string.
+ "\\S-\\('\\)\\'")
+ "List of regexps matching a quote or an apostrophe.
+In every regexp, quote or apostrophe matched is put in group 1.")
+
+(defun org-export-activate-smart-quotes (s encoding info &optional original)
+ "Replace regular quotes with \"smart\" quotes in string S.
+
+ENCODING is a symbol among `:html', `:latex', `:texinfo' and
+`:utf-8'. INFO is a plist used as a communication channel.
+
+The function has to retrieve information about string
+surroundings in parse tree. It can only happen with an
+unmodified string. Thus, if S has already been through another
+process, a non-nil ORIGINAL optional argument will provide that
+original string.
+
+Return the new string."
+ (if (equal s "") ""
+ (let* ((prev (org-export-get-previous-element (or original s) info))
+ ;; Try to be flexible when computing number of blanks
+ ;; before object. The previous object may be a string
+ ;; introduced by the back-end and not completely parsed.
+ (pre-blank (and prev
+ (or (org-element-property :post-blank prev)
+ ;; A string with missing `:post-blank'
+ ;; property.
+ (and (stringp prev)
+ (string-match " *\\'" prev)
+ (length (match-string 0 prev)))
+ ;; Fallback value.
+ 0)))
+ (next (org-export-get-next-element (or original s) info))
+ (get-smart-quote
+ (lambda (q type)
+ ;; Return smart quote associated to a give quote Q, as
+ ;; a string. TYPE is a symbol among `open', `close' and
+ ;; `apostrophe'.
+ (let ((key (case type
+ (apostrophe 'apostrophe)
+ (open (if (equal "'" q) 'opening-single-quote
+ 'opening-double-quote))
+ (otherwise (if (equal "'" q) 'closing-single-quote
+ 'closing-double-quote)))))
+ (or (plist-get
+ (cdr (assq key
+ (cdr (assoc (plist-get info :language)
+ org-export-smart-quotes-alist))))
+ encoding)
+ q)))))
+ (if (or (equal "\"" s) (equal "'" s))
+ ;; Only a quote: no regexp can match. We have to check both
+ ;; sides and decide what to do.
+ (cond ((and (not prev) (not next)) s)
+ ((not prev) (funcall get-smart-quote s 'open))
+ ((and (not next) (zerop pre-blank))
+ (funcall get-smart-quote s 'close))
+ ((not next) s)
+ ((zerop pre-blank) (funcall get-smart-quote s 'apostrophe))
+ (t (funcall get-smart-quote 'open)))
+ ;; 1. Replace quote character at the beginning of S.
+ (cond
+ ;; Apostrophe?
+ ((and prev (zerop pre-blank)
+ (string-match (nth 2 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'apostrophe)
+ nil t s 1)))
+ ;; Closing quote?
+ ((and prev (zerop pre-blank)
+ (string-match (nth 1 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'close)
+ nil t s 1)))
+ ;; Opening quote?
+ ((and (or (not prev) (> pre-blank 0))
+ (string-match (nth 0 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'open)
+ nil t s 1))))
+ ;; 2. Replace quotes in the middle of the string.
+ (setq s (replace-regexp-in-string
+ ;; Opening quotes.
+ (nth 3 org-export-smart-quotes-regexps)
+ (lambda (text)
+ (funcall get-smart-quote (match-string 1 text) 'open))
+ s nil t 1))
+ (setq s (replace-regexp-in-string
+ ;; Closing quotes.
+ (nth 4 org-export-smart-quotes-regexps)
+ (lambda (text)
+ (funcall get-smart-quote (match-string 1 text) 'close))
+ s nil t 1))
+ (setq s (replace-regexp-in-string
+ ;; Apostrophes.
+ (nth 5 org-export-smart-quotes-regexps)
+ (lambda (text)
+ (funcall get-smart-quote (match-string 1 text) 'apostrophe))
+ s nil t 1))
+ ;; 3. Replace quote character at the end of S.
+ (cond
+ ;; Apostrophe?
+ ((and next (string-match (nth 8 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'apostrophe)
+ nil t s 1)))
+ ;; Closing quote?
+ ((and (not next)
+ (string-match (nth 7 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'close)
+ nil t s 1)))
+ ;; Opening quote?
+ ((and next (string-match (nth 6 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'open)
+ nil t s 1))))
+ ;; Return string with smart quotes.
+ s))))
+
+;;;; 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.
+
+(defsubst 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 &optional n)
+ "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.
+
+When optional argument N is a positive integer, return a list
+containing up to N siblings before BLOB, from farthest to
+closest. With any other non-nil value, return a list containing
+all of them."
+ (let ((siblings
+ ;; An object can belong to the contents of its parent or
+ ;; to a secondary string. We check the latter option
+ ;; first.
+ (let ((parent (org-export-get-parent blob)))
+ (or (let ((sec-value (org-element-property
+ (cdr (assq (org-element-type parent)
+ org-element-secondary-value-alist))
+ parent)))
+ (and (memq blob sec-value) sec-value))
+ (org-element-contents parent))))
+ prev)
+ (catch 'exit
+ (mapc (lambda (obj)
+ (cond ((memq obj (plist-get info :ignore-list)))
+ ((null n) (throw 'exit obj))
+ ((not (wholenump n)) (push obj prev))
+ ((zerop n) (throw 'exit prev))
+ (t (decf n) (push obj prev))))
+ (cdr (memq blob (reverse siblings))))
+ prev)))
+
+(defun org-export-get-next-element (blob info &optional n)
+ "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.
+
+When optional argument N is a positive integer, return a list
+containing up to N siblings after BLOB, from closest to farthest.
+With any other non-nil value, return a list containing all of
+them."
+ (let ((siblings
+ ;; An object can belong to the contents of its parent or to
+ ;; a secondary string. We check the latter option first.
+ (let ((parent (org-export-get-parent blob)))
+ (or (let ((sec-value (org-element-property
+ (cdr (assq (org-element-type parent)
+ org-element-secondary-value-alist))
+ parent)))
+ (cdr (memq blob sec-value)))
+ (cdr (memq blob (org-element-contents parent))))))
+ next)
+ (catch 'exit
+ (mapc (lambda (obj)
+ (cond ((memq obj (plist-get info :ignore-list)))
+ ((null n) (throw 'exit obj))
+ ((not (wholenump n)) (push obj next))
+ ((zerop n) (throw 'exit (nreverse next)))
+ (t (decf n) (push obj next))))
+ siblings)
+ (nreverse next))))
+
+
+;;;; Translation
+;;
+;; `org-export-translate' translates a string according to the language
+;; specified by the LANGUAGE keyword. `org-export-dictionary' contains
+;; the dictionary used for the translation.
+
+(defconst org-export-dictionary
+ '(("%e %n: %c"
+ ("fr" :default "%e %n : %c" :html "%e&nbsp;%n&nbsp;: %c"))
+ ("Author"
+ ("ca" :default "Autor")
+ ("cs" :default "Autor")
+ ("da" :default "Forfatter")
+ ("de" :default "Autor")
+ ("eo" :html "A&#365;toro")
+ ("es" :default "Autor")
+ ("fi" :html "Tekij&auml;")
+ ("fr" :default "Auteur")
+ ("hu" :default "Szerz&otilde;")
+ ("is" :html "H&ouml;fundur")
+ ("it" :default "Autore")
+ ("ja" :html "&#33879;&#32773;" :utf-8 "著者")
+ ("nl" :default "Auteur")
+ ("no" :default "Forfatter")
+ ("nb" :default "Forfatter")
+ ("nn" :default "Forfattar")
+ ("pl" :default "Autor")
+ ("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
+ ("sv" :html "F&ouml;rfattare")
+ ("uk" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
+ ("zh-CN" :html "&#20316;&#32773;" :utf-8 "作者")
+ ("zh-TW" :html "&#20316;&#32773;" :utf-8 "作者"))
+ ("Date"
+ ("ca" :default "Data")
+ ("cs" :default "Datum")
+ ("da" :default "Dato")
+ ("de" :default "Datum")
+ ("eo" :default "Dato")
+ ("es" :default "Fecha")
+ ("fi" :html "P&auml;iv&auml;m&auml;&auml;r&auml;")
+ ("hu" :html "D&aacute;tum")
+ ("is" :default "Dagsetning")
+ ("it" :default "Data")
+ ("ja" :html "&#26085;&#20184;" :utf-8 "日付")
+ ("nl" :default "Datum")
+ ("no" :default "Dato")
+ ("nb" :default "Dato")
+ ("nn" :default "Dato")
+ ("pl" :default "Data")
+ ("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
+ ("sv" :default "Datum")
+ ("uk" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
+ ("zh-CN" :html "&#26085;&#26399;" :utf-8 "日期")
+ ("zh-TW" :html "&#26085;&#26399;" :utf-8 "日期"))
+ ("Equation"
+ ("da" :default "Ligning")
+ ("de" :default "Gleichung")
+ ("es" :html "Ecuaci&oacute;n" :default "Ecuación")
+ ("fr" :ascii "Equation" :default "Équation")
+ ("no" :default "Ligning")
+ ("nb" :default "Ligning")
+ ("nn" :default "Likning")
+ ("sv" :default "Ekvation")
+ ("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程"))
+ ("Figure"
+ ("da" :default "Figur")
+ ("de" :default "Abbildung")
+ ("es" :default "Figura")
+ ("ja" :html "&#22259;" :utf-8 "図")
+ ("no" :default "Illustrasjon")
+ ("nb" :default "Illustrasjon")
+ ("nn" :default "Illustrasjon")
+ ("sv" :default "Illustration")
+ ("zh-CN" :html "&#22270;" :utf-8 "图"))
+ ("Figure %d:"
+ ("da" :default "Figur %d")
+ ("de" :default "Abbildung %d:")
+ ("es" :default "Figura %d:")
+ ("fr" :default "Figure %d :" :html "Figure&nbsp;%d&nbsp;:")
+ ("ja" :html "&#22259;%d: " :utf-8 "図%d: ")
+ ("no" :default "Illustrasjon %d")
+ ("nb" :default "Illustrasjon %d")
+ ("nn" :default "Illustrasjon %d")
+ ("sv" :default "Illustration %d")
+ ("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d "))
+ ("Footnotes"
+ ("ca" :html "Peus de p&agrave;gina")
+ ("cs" :default "Pozn\xe1mky pod carou")
+ ("da" :default "Fodnoter")
+ ("de" :html "Fu&szlig;noten" :default "Fußnoten")
+ ("eo" :default "Piednotoj")
+ ("es" :html "Nota al pie de p&aacute;gina" :default "Nota al pie de página")
+ ("fi" :default "Alaviitteet")
+ ("fr" :default "Notes de bas de page")
+ ("hu" :html "L&aacute;bjegyzet")
+ ("is" :html "Aftanm&aacute;lsgreinar")
+ ("it" :html "Note a pi&egrave; di pagina")
+ ("ja" :html "&#33050;&#27880;" :utf-8 "脚注")
+ ("nl" :default "Voetnoten")
+ ("no" :default "Fotnoter")
+ ("nb" :default "Fotnoter")
+ ("nn" :default "Fotnotar")
+ ("pl" :default "Przypis")
+ ("ru" :html "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;" :utf-8 "Сноски")
+ ("sv" :default "Fotnoter")
+ ("uk" :html "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;"
+ :utf-8 "Примітки")
+ ("zh-CN" :html "&#33050;&#27880;" :utf-8 "脚注")
+ ("zh-TW" :html "&#33139;&#35387;" :utf-8 "腳註"))
+ ("List of Listings"
+ ("da" :default "Programmer")
+ ("de" :default "Programmauflistungsverzeichnis")
+ ("es" :default "Indice de Listados de programas")
+ ("fr" :default "Liste des programmes")
+ ("no" :default "Dataprogrammer")
+ ("nb" :default "Dataprogrammer")
+ ("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录"))
+ ("List of Tables"
+ ("da" :default "Tabeller")
+ ("de" :default "Tabellenverzeichnis")
+ ("es" :default "Indice de tablas")
+ ("fr" :default "Liste des tableaux")
+ ("no" :default "Tabeller")
+ ("nb" :default "Tabeller")
+ ("nn" :default "Tabeller")
+ ("sv" :default "Tabeller")
+ ("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录"))
+ ("Listing %d:"
+ ("da" :default "Program %d")
+ ("de" :default "Programmlisting %d")
+ ("es" :default "Listado de programa %d")
+ ("fr" :default "Programme %d :" :html "Programme&nbsp;%d&nbsp;:")
+ ("no" :default "Dataprogram")
+ ("nb" :default "Dataprogram")
+ ("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d "))
+ ("See section %s"
+ ("da" :default "jævnfør afsnit %s")
+ ("de" :default "siehe Abschnitt %s")
+ ("es" :default "vea seccion %s")
+ ("fr" :default "cf. section %s")
+ ("zh-CN" :html "&#21442;&#35265;&#31532;%d&#33410;" :utf-8 "参见第%s节"))
+ ("Table"
+ ("de" :default "Tabelle")
+ ("es" :default "Tabla")
+ ("fr" :default "Tableau")
+ ("ja" :html "&#34920;" :utf-8 "表")
+ ("zh-CN" :html "&#34920;" :utf-8 "表"))
+ ("Table %d:"
+ ("da" :default "Tabel %d")
+ ("de" :default "Tabelle %d")
+ ("es" :default "Tabla %d")
+ ("fr" :default "Tableau %d :")
+ ("ja" :html "&#34920;%d:" :utf-8 "表%d:")
+ ("no" :default "Tabell %d")
+ ("nb" :default "Tabell %d")
+ ("nn" :default "Tabell %d")
+ ("sv" :default "Tabell %d")
+ ("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d "))
+ ("Table of Contents"
+ ("ca" :html "&Iacute;ndex")
+ ("cs" :default "Obsah")
+ ("da" :default "Indhold")
+ ("de" :default "Inhaltsverzeichnis")
+ ("eo" :default "Enhavo")
+ ("es" :html "&Iacute;ndice")
+ ("fi" :html "Sis&auml;llysluettelo")
+ ("fr" :ascii "Sommaire" :default "Table des matières")
+ ("hu" :html "Tartalomjegyz&eacute;k")
+ ("is" :default "Efnisyfirlit")
+ ("it" :default "Indice")
+ ("ja" :html "&#30446;&#27425;" :utf-8 "目次")
+ ("nl" :default "Inhoudsopgave")
+ ("no" :default "Innhold")
+ ("nb" :default "Innhold")
+ ("nn" :default "Innhald")
+ ("pl" :html "Spis tre&#x015b;ci")
+ ("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;"
+ :utf-8 "Содержание")
+ ("sv" :html "Inneh&aring;ll")
+ ("uk" :html "&#1047;&#1084;&#1110;&#1089;&#1090;" :utf-8 "Зміст")
+ ("zh-CN" :html "&#30446;&#24405;" :utf-8 "目录")
+ ("zh-TW" :html "&#30446;&#37636;" :utf-8 "目錄"))
+ ("Unknown reference"
+ ("da" :default "ukendt reference")
+ ("de" :default "Unbekannter Verweis")
+ ("es" :default "referencia desconocida")
+ ("fr" :ascii "Destination inconnue" :default "Référence inconnue")
+ ("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用")))
+ "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, try to fall back
+to `:default' encoding. If it fails, return S."
+ (let* ((lang (plist-get info :language))
+ (translations (cdr (assoc lang
+ (cdr (assoc s org-export-dictionary))))))
+ (or (plist-get translations encoding)
+ (plist-get translations :default)
+ s)))
+
+
+
+;;; Asynchronous Export
+;;
+;; `org-export-async-start' is the entry point for asynchronous
+;; export. It recreates current buffer (including visibility,
+;; narrowing and visited file) in an external Emacs process, and
+;; evaluates a command there. It then applies a function on the
+;; returned results in the current process.
+;;
+;; At a higher level, `org-export-to-buffer' and `org-export-to-file'
+;; allow to export to a buffer or a file, asynchronously or not.
+;;
+;; `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.
+;;
+;; Asynchronously generated results are never displayed directly.
+;; Instead, they are stored in `org-export-stack-contents'. They can
+;; then be retrieved by calling `org-export-stack'.
+;;
+;; Export Stack is viewed through a dedicated major mode
+;;`org-export-stack-mode' and tools: `org-export-stack-refresh',
+;;`org-export-stack-delete', `org-export-stack-view' and
+;;`org-export-stack-clear'.
+;;
+;; For back-ends, `org-export-add-to-stack' add a new source to stack.
+;; It should be used whenever `org-export-async-start' is called.
+
+(defmacro org-export-async-start (fun &rest body)
+ "Call function FUN on the results returned by BODY evaluation.
+
+BODY evaluation happens in an asynchronous process, from a buffer
+which is an exact copy of the current one.
+
+Use `org-export-add-to-stack' in FUN in order to register results
+in the stack.
+
+This is a low level function. See also `org-export-to-buffer'
+and `org-export-to-file' for more specialized functions."
+ (declare (indent 1) (debug t))
+ (org-with-gensyms (process temp-file copy-fun proc-buffer coding)
+ ;; Write the full sexp evaluating BODY in a copy of the current
+ ;; buffer to a temporary file, as it may be too long for program
+ ;; args in `start-process'.
+ `(with-temp-message "Initializing asynchronous export process"
+ (let ((,copy-fun (org-export--generate-copy-script (current-buffer)))
+ (,temp-file (make-temp-file "org-export-process"))
+ (,coding buffer-file-coding-system))
+ (with-temp-file ,temp-file
+ (insert
+ ;; Null characters (from variable values) are inserted
+ ;; within the file. As a consequence, coding system for
+ ;; buffer contents will not be recognized properly. So,
+ ;; we make sure it is the same as the one used to display
+ ;; the original buffer.
+ (format ";; -*- coding: %s; -*-\n%S"
+ ,coding
+ `(with-temp-buffer
+ (when org-export-async-debug '(setq debug-on-error t))
+ ;; Ignore `kill-emacs-hook' and code evaluation
+ ;; queries from Babel as we need a truly
+ ;; non-interactive process.
+ (setq kill-emacs-hook nil
+ org-babel-confirm-evaluate-answer-no t)
+ ;; Initialize export framework.
+ (require 'ox)
+ ;; Re-create current buffer there.
+ (funcall ,,copy-fun)
+ (restore-buffer-modified-p nil)
+ ;; Sexp to evaluate in the buffer.
+ (print (progn ,,@body))))))
+ ;; Start external process.
+ (let* ((process-connection-type nil)
+ (,proc-buffer (generate-new-buffer-name "*Org Export Process*"))
+ (,process
+ (start-process
+ "org-export-process" ,proc-buffer
+ (expand-file-name invocation-name invocation-directory)
+ "-Q" "--batch"
+ "-l" org-export-async-init-file
+ "-l" ,temp-file)))
+ ;; Register running process in stack.
+ (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process)
+ ;; Set-up sentinel in order to catch results.
+ (let ((handler ,fun))
+ (set-process-sentinel
+ ,process
+ `(lambda (p status)
+ (let ((proc-buffer (process-buffer p)))
+ (when (eq (process-status p) 'exit)
+ (unwind-protect
+ (if (zerop (process-exit-status p))
+ (unwind-protect
+ (let ((results
+ (with-current-buffer proc-buffer
+ (goto-char (point-max))
+ (backward-sexp)
+ (read (current-buffer)))))
+ (funcall ,handler results))
+ (unless org-export-async-debug
+ (and (get-buffer proc-buffer)
+ (kill-buffer proc-buffer))))
+ (org-export-add-to-stack proc-buffer nil p)
+ (ding)
+ (message "Process '%s' exited abnormally" p))
+ (unless org-export-async-debug
+ (delete-file ,,temp-file)))))))))))))
+
+;;;###autoload
+(defun org-export-to-buffer
+ (backend buffer
+ &optional async subtreep visible-only body-only ext-plist
+ post-process)
+ "Call `org-export-as' with output to a specified buffer.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
+BUFFER is the name of the output buffer. If it already exists,
+it will be erased first, otherwise, it will be created.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should then be accessible
+through the `org-export-stack' interface. When ASYNC is nil, the
+buffer is displayed if `org-export-show-temporary-export-buffer'
+is non-nil.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
+EXT-PLIST are similar to those used in `org-export-as', which
+see.
+
+Optional argument POST-PROCESS is a function which should accept
+no argument. It is always called within the current process,
+from BUFFER, with point at its beginning. Export back-ends can
+use it to set a major mode there, e.g,
+
+ \(defun org-latex-export-as-latex
+ \(&optional async subtreep visible-only body-only ext-plist)
+ \(interactive)
+ \(org-export-to-buffer 'latex \"*Org LATEX Export*\"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+
+This function returns BUFFER."
+ (declare (indent 2))
+ (if async
+ (org-export-async-start
+ `(lambda (output)
+ (with-current-buffer (get-buffer-create ,buffer)
+ (erase-buffer)
+ (setq buffer-file-coding-system ',buffer-file-coding-system)
+ (insert output)
+ (goto-char (point-min))
+ (org-export-add-to-stack (current-buffer) ',backend)
+ (ignore-errors (funcall ,post-process))))
+ `(org-export-as
+ ',backend ,subtreep ,visible-only ,body-only ',ext-plist))
+ (let ((output
+ (org-export-as backend subtreep visible-only body-only ext-plist))
+ (buffer (get-buffer-create buffer))
+ (encoding buffer-file-coding-system))
+ (when (and (org-string-nw-p output) (org-export--copy-to-kill-ring-p))
+ (org-kill-new output))
+ (with-current-buffer buffer
+ (erase-buffer)
+ (setq buffer-file-coding-system encoding)
+ (insert output)
+ (goto-char (point-min))
+ (and (functionp post-process) (funcall post-process)))
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window buffer))
+ buffer)))
+
+;;;###autoload
+(defun org-export-to-file
+ (backend file &optional async subtreep visible-only body-only ext-plist
+ post-process)
+ "Call `org-export-as' with output to a specified file.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. FILE is the name of the output file, as
+a string.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer file then be accessible
+through the `org-export-stack' interface.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
+EXT-PLIST are similar to those used in `org-export-as', which
+see.
+
+Optional argument POST-PROCESS is called with FILE as its
+argument and happens asynchronously when ASYNC is non-nil. It
+has to return a file name, or nil. Export back-ends can use this
+to send the output file through additional processing, e.g,
+
+ \(defun org-latex-export-to-latex
+ \(&optional async subtreep visible-only body-only ext-plist)
+ \(interactive)
+ \(let ((outfile (org-export-output-file-name \".tex\" subtreep)))
+ \(org-export-to-file 'latex outfile
+ async subtreep visible-only body-only ext-plist
+ \(lambda (file) (org-latex-compile file)))
+
+The function returns either a file name returned by POST-PROCESS,
+or FILE."
+ (declare (indent 2))
+ (if (not (file-writable-p file)) (error "Output file not writable")
+ (let ((encoding (or org-export-coding-system buffer-file-coding-system)))
+ (if async
+ (org-export-async-start
+ `(lambda (file)
+ (org-export-add-to-stack (expand-file-name file) ',backend))
+ `(let ((output
+ (org-export-as
+ ',backend ,subtreep ,visible-only ,body-only
+ ',ext-plist)))
+ (with-temp-buffer
+ (insert output)
+ (let ((coding-system-for-write ',encoding))
+ (write-file ,file)))
+ (or (ignore-errors (funcall ',post-process ,file)) ,file)))
+ (let ((output (org-export-as
+ backend subtreep visible-only body-only ext-plist)))
+ (with-temp-buffer
+ (insert output)
+ (let ((coding-system-for-write encoding))
+ (write-file file)))
+ (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output))
+ (org-kill-new output))
+ ;; Get proper return value.
+ (or (and (functionp post-process) (funcall post-process file))
+ 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."
+ (let* ((visited-file (buffer-file-name (buffer-base-buffer)))
+ (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.
+ (and visited-file (file-name-nondirectory visited-file))
+ ;; 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)))))))
+ (output-file
+ ;; 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))
+ ((file-name-absolute-p base-name) (concat base-name extension))
+ (t (concat (file-name-as-directory ".") base-name extension)))))
+ ;; If writing to OUTPUT-FILE would overwrite original file, append
+ ;; EXTENSION another time to final name.
+ (if (and visited-file (org-file-equal-p visited-file output-file))
+ (concat output-file extension)
+ output-file)))
+
+(defun org-export-add-to-stack (source backend &optional process)
+ "Add a new result to export stack if not present already.
+
+SOURCE is a buffer or a file name containing export results.
+BACKEND is a symbol representing export back-end used to generate
+it.
+
+Entries already pointing to SOURCE and unavailable entries are
+removed beforehand. Return the new stack."
+ (setq org-export-stack-contents
+ (cons (list source backend (or process (current-time)))
+ (org-export-stack-remove source))))
+
+(defun org-export-stack ()
+ "Menu for asynchronous export results and running processes."
+ (interactive)
+ (let ((buffer (get-buffer-create "*Org Export Stack*")))
+ (set-buffer buffer)
+ (when (zerop (buffer-size)) (org-export-stack-mode))
+ (org-export-stack-refresh)
+ (pop-to-buffer buffer))
+ (message "Type \"q\" to quit, \"?\" for help"))
+
+(defun org-export--stack-source-at-point ()
+ "Return source from export results at point in stack."
+ (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents))))
+ (if (not source) (error "Source unavailable, please refresh buffer")
+ (let ((source-name (if (stringp source) source (buffer-name source))))
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at (concat ".* +" (regexp-quote source-name) "$")))
+ source
+ ;; SOURCE is not consistent with current line. The stack
+ ;; view is outdated.
+ (error "Source unavailable; type `g' to update buffer"))))))
+
+(defun org-export-stack-clear ()
+ "Remove all entries from export stack."
+ (interactive)
+ (setq org-export-stack-contents nil))
+
+(defun org-export-stack-refresh (&rest dummy)
+ "Refresh the asynchronous export stack.
+DUMMY is ignored. Unavailable sources are removed from the list.
+Return the new stack."
+ (let ((inhibit-read-only t))
+ (org-preserve-lc
+ (erase-buffer)
+ (insert (concat
+ (let ((counter 0))
+ (mapconcat
+ (lambda (entry)
+ (let ((proc-p (processp (nth 2 entry))))
+ (concat
+ ;; Back-end.
+ (format " %-12s " (or (nth 1 entry) ""))
+ ;; Age.
+ (let ((data (nth 2 entry)))
+ (if proc-p (format " %6s " (process-status data))
+ ;; Compute age of the results.
+ (org-format-seconds
+ "%4h:%.2m "
+ (float-time (time-since data)))))
+ ;; Source.
+ (format " %s"
+ (let ((source (car entry)))
+ (if (stringp source) source
+ (buffer-name source)))))))
+ ;; Clear stack from exited processes, dead buffers or
+ ;; non-existent files.
+ (setq org-export-stack-contents
+ (org-remove-if-not
+ (lambda (el)
+ (if (processp (nth 2 el))
+ (buffer-live-p (process-buffer (nth 2 el)))
+ (let ((source (car el)))
+ (if (bufferp source) (buffer-live-p source)
+ (file-exists-p source)))))
+ org-export-stack-contents)) "\n")))))))
+
+(defun org-export-stack-remove (&optional source)
+ "Remove export results at point from stack.
+If optional argument SOURCE is non-nil, remove it instead."
+ (interactive)
+ (let ((source (or source (org-export--stack-source-at-point))))
+ (setq org-export-stack-contents
+ (org-remove-if (lambda (el) (equal (car el) source))
+ org-export-stack-contents))))
+
+(defun org-export-stack-view (&optional in-emacs)
+ "View export results at point in stack.
+With an optional prefix argument IN-EMACS, force viewing files
+within Emacs."
+ (interactive "P")
+ (let ((source (org-export--stack-source-at-point)))
+ (cond ((processp source)
+ (org-switch-to-buffer-other-window (process-buffer source)))
+ ((bufferp source) (org-switch-to-buffer-other-window source))
+ (t (org-open-file source in-emacs)))))
+
+(defvar org-export-stack-mode-map
+ (let ((km (make-sparse-keymap)))
+ (define-key km " " 'next-line)
+ (define-key km "n" 'next-line)
+ (define-key km "\C-n" 'next-line)
+ (define-key km [down] 'next-line)
+ (define-key km "p" 'previous-line)
+ (define-key km "\C-p" 'previous-line)
+ (define-key km "\C-?" 'previous-line)
+ (define-key km [up] 'previous-line)
+ (define-key km "C" 'org-export-stack-clear)
+ (define-key km "v" 'org-export-stack-view)
+ (define-key km (kbd "RET") 'org-export-stack-view)
+ (define-key km "d" 'org-export-stack-remove)
+ km)
+ "Keymap for Org Export Stack.")
+
+(define-derived-mode org-export-stack-mode special-mode "Org-Stack"
+ "Mode for displaying asynchronous export stack.
+
+Type \\[org-export-stack] to visualize the asynchronous export
+stack.
+
+In an Org Export Stack buffer, use \\<org-export-stack-mode-map>\\[org-export-stack-view] to view export output
+on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear
+stack completely.
+
+Removing entries in an Org Export Stack buffer doesn't affect
+files or buffers, only the display.
+
+\\{org-export-stack-mode-map}"
+ (abbrev-mode 0)
+ (auto-fill-mode 0)
+ (setq buffer-read-only t
+ buffer-undo-list t
+ truncate-lines t
+ header-line-format
+ '(:eval
+ (format " %-12s | %6s | %s" "Back-End" "Age" "Source")))
+ (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t)
+ (set (make-local-variable 'revert-buffer-function)
+ 'org-export-stack-refresh))
+
+
+
+;;; 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, which, in turn, delegates response to key
+;; pressed to `org-export--dispatch-action'.
+
+;;;###autoload
+(defun org-export-dispatch (&optional arg)
+ "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 in a dedicated buffer.
+Scrolling (resp. line-wise motion) in this buffer is done with
+SPC and DEL (resp. C-n and C-p) keys.
+
+Set variable `org-export-dispatch-use-expert-ui' to switch to one
+flavour or the other.
+
+When ARG is \\[universal-argument], repeat the last export action, with the same set
+of options used back then, on the current buffer.
+
+When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack."
+ (interactive "P")
+ (let* ((input
+ (cond ((equal arg '(16)) '(stack))
+ ((and arg org-export-dispatch-last-action))
+ (t (save-window-excursion
+ (unwind-protect
+ (progn
+ ;; Remember where we are
+ (move-marker org-export-dispatch-last-position
+ (point)
+ (org-base-buffer (current-buffer)))
+ ;; Get and store an export command
+ (setq org-export-dispatch-last-action
+ (org-export--dispatch-ui
+ (list org-export-initial-scope
+ (and org-export-in-background 'async))
+ nil
+ org-export-dispatch-use-expert-ui)))
+ (and (get-buffer "*Org Export Dispatcher*")
+ (kill-buffer "*Org Export Dispatcher*")))))))
+ (action (car input))
+ (optns (cdr input)))
+ (unless (memq 'subtree optns)
+ (move-marker org-export-dispatch-last-position nil))
+ (case action
+ ;; First handle special hard-coded actions.
+ (template (org-export-insert-default-template nil optns))
+ (stack (org-export-stack))
+ (publish-current-file
+ (org-publish-current-file (memq 'force optns) (memq 'async optns)))
+ (publish-current-project
+ (org-publish-current-project (memq 'force optns) (memq 'async optns)))
+ (publish-choose-project
+ (org-publish (assoc (org-icompleting-read
+ "Publish project: "
+ org-publish-project-alist nil t)
+ org-publish-project-alist)
+ (memq 'force optns)
+ (memq 'async optns)))
+ (publish-all (org-publish-all (memq 'force optns) (memq 'async optns)))
+ (otherwise
+ (save-excursion
+ (when arg
+ ;; Repeating command, maybe move cursor to restore subtree
+ ;; context.
+ (if (eq (marker-buffer org-export-dispatch-last-position)
+ (org-base-buffer (current-buffer)))
+ (goto-char org-export-dispatch-last-position)
+ ;; We are in a different buffer, forget position.
+ (move-marker org-export-dispatch-last-position nil)))
+ (funcall action
+ ;; Return a symbol instead of a list to ease
+ ;; asynchronous export macro use.
+ (and (memq 'async optns) t)
+ (and (memq 'subtree optns) t)
+ (and (memq 'visible optns) t)
+ (and (memq 'body optns) t)))))))
+
+(defun org-export--dispatch-ui (options first-key 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.
+`async' use asynchronous export process
+
+FIRST-KEY is the key pressed to select the first level menu. It
+is nil when this menu hasn't been selected yet.
+
+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."
+ (let* ((fontify-key
+ (lambda (key &optional access-key)
+ ;; Fontify KEY string. Optional argument ACCESS-KEY, when
+ ;; non-nil is the required first-level key to activate
+ ;; KEY. When its value is t, activate KEY independently
+ ;; on the first key, if any. A nil value means KEY will
+ ;; only be activated at first level.
+ (if (or (eq access-key t) (eq access-key first-key))
+ (org-propertize key 'face 'org-warning)
+ key)))
+ (fontify-value
+ (lambda (value)
+ ;; Fontify VALUE string.
+ (org-propertize value 'face 'font-lock-variable-name-face)))
+ ;; Prepare menu entries by extracting them from registered
+ ;; back-ends and sorting them by access key and by ordinal,
+ ;; if any.
+ (entries
+ (sort (sort (delq nil
+ (mapcar 'org-export-backend-menu
+ org-export--registered-backends))
+ (lambda (a b)
+ (let ((key-a (nth 1 a))
+ (key-b (nth 1 b)))
+ (cond ((and (numberp key-a) (numberp key-b))
+ (< key-a key-b))
+ ((numberp key-b) t)))))
+ 'car-less-than-car))
+ ;; Compute a list of allowed keys based on the first key
+ ;; pressed, if any. Some keys
+ ;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always
+ ;; available.
+ (allowed-keys
+ (nconc (list 2 22 19 6 1)
+ (if (not first-key) (org-uniquify (mapcar 'car entries))
+ (let (sub-menu)
+ (dolist (entry entries (sort (mapcar 'car sub-menu) '<))
+ (when (eq (car entry) first-key)
+ (setq sub-menu (append (nth 2 entry) sub-menu))))))
+ (cond ((eq first-key ?P) (list ?f ?p ?x ?a))
+ ((not first-key) (list ?P)))
+ (list ?& ?#)
+ (when expertp (list ??))
+ (list ?q)))
+ ;; Build the help menu for standard UI.
+ (help
+ (unless expertp
+ (concat
+ ;; Options are hard-coded.
+ (format "[%s] Body only: %s [%s] Visible only: %s
+\[%s] Export scope: %s [%s] Force publishing: %s
+\[%s] Async export: %s\n\n"
+ (funcall fontify-key "C-b" t)
+ (funcall fontify-value
+ (if (memq 'body options) "On " "Off"))
+ (funcall fontify-key "C-v" t)
+ (funcall fontify-value
+ (if (memq 'visible options) "On " "Off"))
+ (funcall fontify-key "C-s" t)
+ (funcall fontify-value
+ (if (memq 'subtree options) "Subtree" "Buffer "))
+ (funcall fontify-key "C-f" t)
+ (funcall fontify-value
+ (if (memq 'force options) "On " "Off"))
+ (funcall fontify-key "C-a" t)
+ (funcall fontify-value
+ (if (memq 'async options) "On " "Off")))
+ ;; Display registered back-end entries. When a key
+ ;; appears for the second time, do not create another
+ ;; entry, but append its sub-menu to existing menu.
+ (let (last-key)
+ (mapconcat
+ (lambda (entry)
+ (let ((top-key (car entry)))
+ (concat
+ (unless (eq top-key last-key)
+ (setq last-key top-key)
+ (format "\n[%s] %s\n"
+ (funcall fontify-key (char-to-string top-key))
+ (nth 1 entry)))
+ (let ((sub-menu (nth 2 entry)))
+ (unless (functionp sub-menu)
+ ;; Split sub-menu into two columns.
+ (let ((index -1))
+ (concat
+ (mapconcat
+ (lambda (sub-entry)
+ (incf index)
+ (format
+ (if (zerop (mod index 2)) " [%s] %-26s"
+ "[%s] %s\n")
+ (funcall fontify-key
+ (char-to-string (car sub-entry))
+ top-key)
+ (nth 1 sub-entry)))
+ sub-menu "")
+ (when (zerop (mod index 2)) "\n"))))))))
+ entries ""))
+ ;; Publishing menu is hard-coded.
+ (format "\n[%s] Publish
+ [%s] Current file [%s] Current project
+ [%s] Choose project [%s] All projects\n\n\n"
+ (funcall fontify-key "P")
+ (funcall fontify-key "f" ?P)
+ (funcall fontify-key "p" ?P)
+ (funcall fontify-key "x" ?P)
+ (funcall fontify-key "a" ?P))
+ (format "[%s] Export stack [%s] Insert template\n"
+ (funcall fontify-key "&" t)
+ (funcall fontify-key "#" t))
+ (format "[%s] %s"
+ (funcall fontify-key "q" t)
+ (if first-key "Main menu" "Exit")))))
+ ;; Build prompts for both standard and expert UI.
+ (standard-prompt (unless expertp "Export command: "))
+ (expert-prompt
+ (when expertp
+ (format
+ "Export command (C-%s%s%s%s%s) [%s]: "
+ (if (memq 'body options) (funcall fontify-key "b" t) "b")
+ (if (memq 'visible options) (funcall fontify-key "v" t) "v")
+ (if (memq 'subtree options) (funcall fontify-key "s" t) "s")
+ (if (memq 'force options) (funcall fontify-key "f" t) "f")
+ (if (memq 'async options) (funcall fontify-key "a" t) "a")
+ (mapconcat (lambda (k)
+ ;; Strip control characters.
+ (unless (< k 27) (char-to-string k)))
+ allowed-keys "")))))
+ ;; With expert UI, just read key with a fancy prompt. In standard
+ ;; UI, display an intrusive help buffer.
+ (if expertp
+ (org-export--dispatch-action
+ expert-prompt allowed-keys entries options first-key expertp)
+ ;; At first call, create frame layout in order to display menu.
+ (unless (get-buffer "*Org Export Dispatcher*")
+ (delete-other-windows)
+ (org-switch-to-buffer-other-window
+ (get-buffer-create "*Org Export Dispatcher*"))
+ (setq cursor-type nil
+ header-line-format "Use SPC, DEL, C-n or C-p to navigate.")
+ ;; Make sure that invisible cursor will not highlight square
+ ;; brackets.
+ (set-syntax-table (copy-syntax-table))
+ (modify-syntax-entry ?\[ "w"))
+ ;; At this point, the buffer containing the menu exists and is
+ ;; visible in the current window. So, refresh it.
+ (with-current-buffer "*Org Export Dispatcher*"
+ ;; Refresh help. Maintain display continuity by re-visiting
+ ;; previous window position.
+ (let ((pos (window-start)))
+ (erase-buffer)
+ (insert help)
+ (set-window-start nil pos)))
+ (org-fit-window-to-buffer)
+ (org-export--dispatch-action
+ standard-prompt allowed-keys entries options first-key expertp))))
+
+(defun org-export--dispatch-action
+ (prompt allowed-keys entries options first-key expertp)
+ "Read a character from command input and act accordingly.
+
+PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is
+a list of characters available at a given step in the process.
+ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and
+EXPERTP are the same as defined in `org-export--dispatch-ui',
+which see.
+
+Toggle export options when required. Otherwise, return value is
+a list with action as CAR and a list of interactive export
+options as CDR."
+ (let (key)
+ ;; Scrolling: when in non-expert mode, act on motion keys (C-n,
+ ;; C-p, SPC, DEL).
+ (while (and (setq key (read-char-exclusive prompt))
+ (not expertp)
+ (memq key '(14 16 ?\s ?\d)))
+ (case key
+ (14 (if (not (pos-visible-in-window-p (point-max)))
+ (ignore-errors (scroll-up 1))
+ (message "End of buffer")
+ (sit-for 1)))
+ (16 (if (not (pos-visible-in-window-p (point-min)))
+ (ignore-errors (scroll-down 1))
+ (message "Beginning of buffer")
+ (sit-for 1)))
+ (?\s (if (not (pos-visible-in-window-p (point-max)))
+ (scroll-up nil)
+ (message "End of buffer")
+ (sit-for 1)))
+ (?\d (if (not (pos-visible-in-window-p (point-min)))
+ (scroll-down nil)
+ (message "Beginning of buffer")
+ (sit-for 1)))))
+ (cond
+ ;; Ignore undefined associations.
+ ((not (memq key allowed-keys))
+ (ding)
+ (unless expertp (message "Invalid key") (sit-for 1))
+ (org-export--dispatch-ui options first-key expertp))
+ ;; q key at first level aborts export. At second level, cancel
+ ;; first key instead.
+ ((eq key ?q) (if (not first-key) (error "Export aborted")
+ (org-export--dispatch-ui options nil expertp)))
+ ;; Help key: Switch back to standard interface if expert UI was
+ ;; active.
+ ((eq key ??) (org-export--dispatch-ui options first-key nil))
+ ;; Send request for template insertion along with export scope.
+ ((eq key ?#) (cons 'template (memq 'subtree options)))
+ ;; Switch to asynchronous export stack.
+ ((eq key ?&) '(stack))
+ ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1).
+ ((memq key '(2 22 19 6 1))
+ (org-export--dispatch-ui
+ (let ((option (case key (2 'body) (22 'visible) (19 'subtree)
+ (6 'force) (1 'async))))
+ (if (memq option options) (remq option options)
+ (cons option options)))
+ first-key expertp))
+ ;; Action selected: Send key and options back to
+ ;; `org-export-dispatch'.
+ ((or first-key (functionp (nth 2 (assq key entries))))
+ (cons (cond
+ ((not first-key) (nth 2 (assq key entries)))
+ ;; Publishing actions are hard-coded. Send a special
+ ;; signal to `org-export-dispatch'.
+ ((eq first-key ?P)
+ (case key
+ (?f 'publish-current-file)
+ (?p 'publish-current-project)
+ (?x 'publish-choose-project)
+ (?a 'publish-all)))
+ ;; Return first action associated to FIRST-KEY + KEY
+ ;; path. Indeed, derived backends can share the same
+ ;; FIRST-KEY.
+ (t (catch 'found
+ (mapc (lambda (entry)
+ (let ((match (assq key (nth 2 entry))))
+ (when match (throw 'found (nth 2 match)))))
+ (member (assq first-key entries) entries)))))
+ options))
+ ;; Otherwise, enter sub-menu.
+ (t (org-export--dispatch-ui options key expertp)))))
+
+
+
+(provide 'ox)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox.el ends here