diff options
| author | Sébastien Delafond <sdelafond@gmail.com> | 2014-07-13 13:35:01 +0200 |
|---|---|---|
| committer | Sébastien Delafond <sdelafond@gmail.com> | 2014-07-13 13:35:01 +0200 |
| commit | 7697fa4daf3ec84f85711a84035d8f0224afd4e3 (patch) | |
| tree | 24d0f1d2a9751ca8c063409fd2ab71478b296efb /contrib/lisp/org-export.el | |
Imported Upstream version 7.9.2
Diffstat (limited to 'contrib/lisp/org-export.el')
| -rw-r--r-- | contrib/lisp/org-export.el | 4518 |
1 files changed, 4518 insertions, 0 deletions
diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el new file mode 100644 index 0000000..4f01b7e --- /dev/null +++ b/contrib/lisp/org-export.el @@ -0,0 +1,4518 @@ +;;; org-export.el --- Generic Export Engine For Org + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This library implements a generic export engine for Org, built on +;; its syntactical parser: Org Elements. +;; +;; Besides that parser, the generic exporter is made of three distinct +;; parts: +;; +;; - The communication channel consists in a property list, which is +;; created and updated during the process. Its use is to offer +;; every piece of information, would it be about initial environment +;; or contextual data, all in a single place. The exhaustive list +;; of properties is given in "The Communication Channel" section of +;; this file. +;; +;; - The transcoder walks the parse tree, ignores or treat as plain +;; text elements and objects according to export options, and +;; eventually calls back-end specific functions to do the real +;; transcoding, concatenating their return value along the way. +;; +;; - The filter system is activated at the very beginning and the very +;; end of the export process, and each time an element or an object +;; has been converted. It is the entry point to fine-tune standard +;; output from back-end transcoders. See "The Filter System" +;; section for more information. +;; +;; The core function is `org-export-as'. It returns the transcoded +;; buffer as a string. +;; +;; An export back-end is defined with `org-export-define-backend', +;; which sets one mandatory variable: his translation table. Its name +;; is always `org-BACKEND-translate-alist' where BACKEND stands for +;; the name chosen for the back-end. Its value is an alist whose keys +;; are elements and objects types and values translator functions. +;; See function's docstring for more information about translators. +;; +;; Optionally, `org-export-define-backend' can also support specific +;; buffer keywords, OPTION keyword's items and filters. Also refer to +;; function documentation for more information. +;; +;; If the new back-end shares most properties with another one, +;; `org-export-define-derived-backend' can be used to simplify the +;; process. +;; +;; Any back-end can define its own variables. Among them, those +;; customizable should belong to the `org-export-BACKEND' group. +;; +;; Tools for common tasks across back-ends are implemented in the +;; penultimate part of this file. A dispatcher for standard back-ends +;; is provided in the last one. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'org-element) + + +(declare-function org-e-ascii-export-as-ascii "org-e-ascii" + (&optional subtreep visible-only body-only ext-plist)) +(declare-function org-e-ascii-export-to-ascii "org-e-ascii" + (&optional subtreep visible-only body-only ext-plist pub-dir)) +(declare-function org-e-html-export-as-html "org-e-html" + (&optional subtreep visible-only body-only ext-plist)) +(declare-function org-e-html-export-to-html "org-e-html" + (&optional subtreep visible-only body-only ext-plist pub-dir)) +(declare-function org-e-latex-export-as-latex "org-e-latex" + (&optional subtreep visible-only body-only ext-plist)) +(declare-function org-e-latex-export-to-latex "org-e-latex" + (&optional subtreep visible-only body-only ext-plist pub-dir)) +(declare-function org-e-latex-export-to-pdf "org-e-latex" + (&optional subtreep visible-only body-only ext-plist pub-dir)) +(declare-function org-e-odt-export-to-odt "org-e-odt" + (&optional subtreep visible-only body-only ext-plist pub-dir)) +(declare-function org-e-publish "org-e-publish" (project &optional force)) +(declare-function org-e-publish-all "org-e-publish" (&optional force)) +(declare-function org-e-publish-current-file "org-e-publish" (&optional force)) +(declare-function org-e-publish-current-project "org-e-publish" + (&optional force)) +(declare-function org-export-blocks-preprocess "org-exp-blocks") + +(defvar org-e-publish-project-alist) +(defvar org-table-number-fraction) +(defvar org-table-number-regexp) + + + +;;; Internal Variables +;; +;; Among internal variables, the most important is +;; `org-export-options-alist'. This variable define the global export +;; options, shared between every exporter, and how they are acquired. + +(defconst org-export-max-depth 19 + "Maximum nesting depth for headlines, counting from 0.") + +(defconst org-export-options-alist + '((:author "AUTHOR" nil user-full-name t) + (:creator "CREATOR" nil org-export-creator-string) + (:date "DATE" nil nil t) + (:description "DESCRIPTION" nil nil newline) + (:email "EMAIL" nil user-mail-address t) + (:exclude-tags "EXCLUDE_TAGS" nil org-export-exclude-tags split) + (:headline-levels nil "H" org-export-headline-levels) + (:keywords "KEYWORDS" nil nil space) + (:language "LANGUAGE" nil org-export-default-language t) + (:preserve-breaks nil "\\n" org-export-preserve-breaks) + (:section-numbers nil "num" org-export-with-section-numbers) + (:select-tags "SELECT_TAGS" nil org-export-select-tags split) + (:time-stamp-file nil "timestamp" org-export-time-stamp-file) + (:title "TITLE" nil nil space) + (:with-archived-trees nil "arch" org-export-with-archived-trees) + (:with-author nil "author" org-export-with-author) + (:with-clocks nil "c" org-export-with-clocks) + (:with-creator nil "creator" org-export-with-creator) + (:with-drawers nil "d" org-export-with-drawers) + (:with-email nil "email" org-export-with-email) + (:with-emphasize nil "*" org-export-with-emphasize) + (:with-entities nil "e" org-export-with-entities) + (:with-fixed-width nil ":" org-export-with-fixed-width) + (:with-footnotes nil "f" org-export-with-footnotes) + (:with-inlinetasks nil "inline" org-export-with-inlinetasks) + (:with-plannings nil "p" org-export-with-planning) + (:with-priority nil "pri" org-export-with-priority) + (:with-special-strings nil "-" org-export-with-special-strings) + (:with-sub-superscript nil "^" org-export-with-sub-superscripts) + (:with-toc nil "toc" org-export-with-toc) + (:with-tables nil "|" org-export-with-tables) + (:with-tags nil "tags" org-export-with-tags) + (:with-tasks nil "tasks" org-export-with-tasks) + (:with-timestamps nil "<" org-export-with-timestamps) + (:with-todo-keywords nil "todo" org-export-with-todo-keywords)) + "Alist between export properties and ways to set them. + +The CAR of the alist is the property name, and the CDR is a list +like (KEYWORD OPTION DEFAULT BEHAVIOUR) where: + +KEYWORD is a string representing a buffer keyword, or nil. Each + property defined this way can also be set, during subtree + export, through an headline property named after the keyword + with the \"EXPORT_\" prefix (i.e. DATE keyword and EXPORT_DATE + property). +OPTION is a string that could be found in an #+OPTIONS: line. +DEFAULT is the default value for the property. +BEHAVIOUR determine how Org should handle multiple keywords for + the same property. It is a symbol among: + nil Keep old value and discard the new one. + t Replace old value with the new one. + `space' Concatenate the values, separating them with a space. + `newline' Concatenate the values, separating them with + a newline. + `split' Split values at white spaces, and cons them to the + previous list. + +KEYWORD and OPTION have precedence over DEFAULT. + +All these properties should be back-end agnostic. Back-end +specific properties are set through `org-export-define-backend'. +Properties redefined there have precedence over these.") + +(defconst org-export-special-keywords + '("SETUP_FILE" "OPTIONS" "MACRO") + "List of in-buffer keywords that require special treatment. +These keywords are not directly associated to a property. The +way they are handled must be hard-coded into +`org-export--get-inbuffer-options' function.") + +(defconst org-export-filters-alist + '((:filter-bold . org-export-filter-bold-functions) + (:filter-babel-call . org-export-filter-babel-call-functions) + (:filter-center-block . org-export-filter-center-block-functions) + (:filter-clock . org-export-filter-clock-functions) + (:filter-code . org-export-filter-code-functions) + (:filter-comment . org-export-filter-comment-functions) + (:filter-comment-block . org-export-filter-comment-block-functions) + (:filter-drawer . org-export-filter-drawer-functions) + (:filter-dynamic-block . org-export-filter-dynamic-block-functions) + (:filter-entity . org-export-filter-entity-functions) + (:filter-example-block . org-export-filter-example-block-functions) + (:filter-export-block . org-export-filter-export-block-functions) + (:filter-export-snippet . org-export-filter-export-snippet-functions) + (:filter-final-output . org-export-filter-final-output-functions) + (:filter-fixed-width . org-export-filter-fixed-width-functions) + (:filter-footnote-definition . org-export-filter-footnote-definition-functions) + (:filter-footnote-reference . org-export-filter-footnote-reference-functions) + (:filter-headline . org-export-filter-headline-functions) + (:filter-horizontal-rule . org-export-filter-horizontal-rule-functions) + (:filter-inline-babel-call . org-export-filter-inline-babel-call-functions) + (:filter-inline-src-block . org-export-filter-inline-src-block-functions) + (:filter-inlinetask . org-export-filter-inlinetask-functions) + (:filter-italic . org-export-filter-italic-functions) + (:filter-item . org-export-filter-item-functions) + (:filter-keyword . org-export-filter-keyword-functions) + (:filter-latex-environment . org-export-filter-latex-environment-functions) + (:filter-latex-fragment . org-export-filter-latex-fragment-functions) + (:filter-line-break . org-export-filter-line-break-functions) + (:filter-link . org-export-filter-link-functions) + (:filter-macro . org-export-filter-macro-functions) + (:filter-paragraph . org-export-filter-paragraph-functions) + (:filter-parse-tree . org-export-filter-parse-tree-functions) + (:filter-plain-list . org-export-filter-plain-list-functions) + (:filter-plain-text . org-export-filter-plain-text-functions) + (:filter-planning . org-export-filter-planning-functions) + (:filter-property-drawer . org-export-filter-property-drawer-functions) + (:filter-quote-block . org-export-filter-quote-block-functions) + (:filter-quote-section . org-export-filter-quote-section-functions) + (:filter-radio-target . org-export-filter-radio-target-functions) + (:filter-section . org-export-filter-section-functions) + (:filter-special-block . org-export-filter-special-block-functions) + (:filter-src-block . org-export-filter-src-block-functions) + (:filter-statistics-cookie . org-export-filter-statistics-cookie-functions) + (:filter-strike-through . org-export-filter-strike-through-functions) + (:filter-subscript . org-export-filter-subscript-functions) + (:filter-superscript . org-export-filter-superscript-functions) + (:filter-table . org-export-filter-table-functions) + (:filter-table-cell . org-export-filter-table-cell-functions) + (:filter-table-row . org-export-filter-table-row-functions) + (:filter-target . org-export-filter-target-functions) + (:filter-timestamp . org-export-filter-timestamp-functions) + (:filter-underline . org-export-filter-underline-functions) + (:filter-verbatim . org-export-filter-verbatim-functions) + (:filter-verse-block . org-export-filter-verse-block-functions)) + "Alist between filters properties and initial values. + +The key of each association is a property name accessible through +the communication channel. Its value is a configurable global +variable defining initial filters. + +This list is meant to install user specified filters. Back-end +developers may install their own filters using +`org-export-define-backend'. Filters defined there will always +be prepended to the current list, so they always get applied +first.") + +(defconst org-export-default-inline-image-rule + `(("file" . + ,(format "\\.%s\\'" + (regexp-opt + '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" + "xpm" "pbm" "pgm" "ppm") t)))) + "Default rule for link matching an inline image. +This rule applies to links with no description. By default, it +will be considered as an inline image if it targets a local file +whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\", +\"tiff\", \"tif\", \"xbm\", \"xpm\", \"pbm\", \"pgm\" or \"ppm\". +See `org-export-inline-image-p' for more information about +rules.") + + + +;;; User-configurable Variables +;; +;; Configuration for the masses. +;; +;; They should never be accessed directly, as their value is to be +;; stored in a property list (cf. `org-export-options-alist'). +;; Back-ends will read their value from there instead. + +(defgroup org-export nil + "Options for exporting Org mode files." + :tag "Org Export" + :group 'org) + +(defgroup org-export-general nil + "General options for export engine." + :tag "Org Export General" + :group 'org-export) + +(defcustom org-export-with-archived-trees 'headline + "Whether sub-trees with the ARCHIVE tag should be exported. + +This can have three different values: +nil Do not export, pretend this tree is not present. +t Do export the entire tree. +`headline' Only export the headline, but skip the tree below it. + +This option can also be set with the #+OPTIONS line, +e.g. \"arch:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "Not at all" nil) + (const :tag "Headline only" 'headline) + (const :tag "Entirely" t))) + +(defcustom org-export-with-author t + "Non-nil means insert author name into the exported file. +This option can also be set with the #+OPTIONS line, +e.g. \"author:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-clocks nil + "Non-nil means export CLOCK keywords. +This option can also be set with the #+OPTIONS line, +e.g. \"c:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-creator 'comment + "Non-nil means the postamble should contain a creator sentence. + +The sentence can be set in `org-export-creator-string' and +defaults to \"Generated by Org mode XX in Emacs XXX.\". + +If the value is `comment' insert it as a comment." + :group 'org-export-general + :type '(choice + (const :tag "No creator sentence" nil) + (const :tag "Sentence as a comment" 'comment) + (const :tag "Insert the sentence" t))) + +(defcustom org-export-creator-string + (format "Generated by Org mode %s in Emacs %s." + (if (fboundp 'org-version) (org-version) "(Unknown)") + emacs-version) + "String to insert at the end of the generated document." + :group 'org-export-general + :type '(string :tag "Creator string")) + +(defcustom org-export-with-drawers t + "Non-nil means export contents of standard drawers. + +When t, all drawers are exported. This may also be a list of +drawer names to export. This variable doesn't apply to +properties drawers. + +This option can also be set with the #+OPTIONS line, +e.g. \"d:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "All drawers" t) + (const :tag "None" nil) + (repeat :tag "Selected drawers" + (string :tag "Drawer name")))) + +(defcustom org-export-with-email nil + "Non-nil means insert author email into the exported file. +This option can also be set with the #+OPTIONS line, +e.g. \"email:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-emphasize t + "Non-nil means interpret *word*, /word/, and _word_ as emphasized text. + +If the export target supports emphasizing text, the word will be +typeset in bold, italic, or underlined, respectively. Not all +export backends support this. + +This option can also be set with the #+OPTIONS line, e.g. \"*:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-exclude-tags '("noexport") + "Tags that exclude a tree from export. + +All trees carrying any of these tags will be excluded from +export. This is without condition, so even subtrees inside that +carry one of the `org-export-select-tags' will be removed. + +This option can also be set with the #+EXCLUDE_TAGS: keyword." + :group 'org-export-general + :type '(repeat (string :tag "Tag"))) + +(defcustom org-export-with-fixed-width t + "Non-nil means lines starting with \":\" will be in fixed width font. + +This can be used to have pre-formatted text, fragments of code +etc. For example: + : ;; Some Lisp examples + : (while (defc cnt) + : (ding)) +will be looking just like this in also HTML. See also the QUOTE +keyword. Not all export backends support this. + +This option can also be set with the #+OPTIONS line, e.g. \"::nil\"." + :group 'org-export-translation + :type 'boolean) + +(defcustom org-export-with-footnotes t + "Non-nil means Org footnotes should be exported. +This option can also be set with the #+OPTIONS line, +e.g. \"f:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-headline-levels 3 + "The last level which is still exported as a headline. + +Inferior levels will produce itemize lists when exported. + +This option can also be set with the #+OPTIONS line, e.g. \"H:2\"." + :group 'org-export-general + :type 'integer) + +(defcustom org-export-default-language "en" + "The default language for export and clocktable translations, as a string. +This may have an association in +`org-clock-clocktable-language-setup'." + :group 'org-export-general + :type '(string :tag "Language")) + +(defcustom org-export-preserve-breaks nil + "Non-nil means preserve all line breaks when exporting. + +Normally, in HTML output paragraphs will be reformatted. + +This option can also be set with the #+OPTIONS line, +e.g. \"\\n:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-entities t + "Non-nil means interpret entities when exporting. + +For example, HTML export converts \\alpha to α and \\AA to +Å. + +For a list of supported names, see the constant `org-entities' +and the user option `org-entities-user'. + +This option can also be set with the #+OPTIONS line, +e.g. \"e:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-inlinetasks t + "Non-nil means inlinetasks should be exported. +This option can also be set with the #+OPTIONS line, +e.g. \"inline:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-planning nil + "Non-nil means include planning info in export. +This option can also be set with the #+OPTIONS: line, +e.g. \"p:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-priority nil + "Non-nil means include priority cookies in export. +This option can also be set with the #+OPTIONS line, +e.g. \"pri:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-section-numbers t + "Non-nil means add section numbers to headlines when exporting. + +When set to an integer n, numbering will only happen for +headlines whose relative level is higher or equal to n. + +This option can also be set with the #+OPTIONS line, +e.g. \"num:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-select-tags '("export") + "Tags that select a tree for export. + +If any such tag is found in a buffer, all trees that do not carry +one of these tags will be ignored during export. Inside trees +that are selected like this, you can still deselect a subtree by +tagging it with one of the `org-export-exclude-tags'. + +This option can also be set with the #+SELECT_TAGS: keyword." + :group 'org-export-general + :type '(repeat (string :tag "Tag"))) + +(defcustom org-export-with-special-strings t + "Non-nil means interpret \"\-\", \"--\" and \"---\" for export. + +When this option is turned on, these strings will be exported as: + + Org HTML LaTeX + -----+----------+-------- + \\- ­ \\- + -- – -- + --- — --- + ... … \ldots + +This option can also be set with the #+OPTIONS line, +e.g. \"-:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-sub-superscripts t + "Non-nil means interpret \"_\" and \"^\" for export. + +When this option is turned on, you can use TeX-like syntax for +sub- and superscripts. Several characters after \"_\" or \"^\" +will be considered as a single item - so grouping with {} is +normally not needed. For example, the following things will be +parsed as single sub- or superscripts. + + 10^24 or 10^tau several digits will be considered 1 item. + 10^-12 or 10^-tau a leading sign with digits or a word + x^2-y^3 will be read as x^2 - y^3, because items are + terminated by almost any nonword/nondigit char. + x_{i^2} or x^(2-i) braces or parenthesis do grouping. + +Still, ambiguity is possible - so when in doubt use {} to enclose +the sub/superscript. If you set this variable to the symbol +`{}', the braces are *required* in order to trigger +interpretations as sub/superscript. This can be helpful in +documents that need \"_\" frequently in plain text. + +This option can also be set with the #+OPTIONS line, +e.g. \"^:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "Interpret them" t) + (const :tag "Curly brackets only" {}) + (const :tag "Do not interpret them" nil))) + +(defcustom org-export-with-toc t + "Non-nil means create a table of contents in exported files. + +The TOC contains headlines with levels up +to`org-export-headline-levels'. When an integer, include levels +up to N in the toc, this may then be different from +`org-export-headline-levels', but it will not be allowed to be +larger than the number of headline levels. When nil, no table of +contents is made. + +This option can also be set with the #+OPTIONS line, +e.g. \"toc:nil\" or \"toc:3\"." + :group 'org-export-general + :type '(choice + (const :tag "No Table of Contents" nil) + (const :tag "Full Table of Contents" t) + (integer :tag "TOC to level"))) + +(defcustom org-export-with-tables t + "If non-nil, lines starting with \"|\" define a table. +For example: + + | Name | Address | Birthday | + |-------------+----------+-----------| + | Arthur Dent | England | 29.2.2100 | + +This option can also be set with the #+OPTIONS line, e.g. \"|:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-tags t + "If nil, do not export tags, just remove them from headlines. + +If this is the symbol `not-in-toc', tags will be removed from +table of contents entries, but still be shown in the headlines of +the document. + +This option can also be set with the #+OPTIONS line, +e.g. \"tags:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "Off" nil) + (const :tag "Not in TOC" not-in-toc) + (const :tag "On" t))) + +(defcustom org-export-with-tasks t + "Non-nil means include TODO items for export. +This may have the following values: +t include tasks independent of state. +todo include only tasks that are not yet done. +done include only tasks that are already done. +nil remove all tasks before export +list of keywords keep only tasks with these keywords" + :group 'org-export-general + :type '(choice + (const :tag "All tasks" t) + (const :tag "No tasks" nil) + (const :tag "Not-done tasks" todo) + (const :tag "Only done tasks" done) + (repeat :tag "Specific TODO keywords" + (string :tag "Keyword")))) + +(defcustom org-export-time-stamp-file t + "Non-nil means insert a time stamp into the exported file. +The time stamp shows when the file was created. + +This option can also be set with the #+OPTIONS line, +e.g. \"timestamp:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-timestamps t + "Non nil means allow timestamps in export. + +It can be set to `active', `inactive', t or nil, in order to +export, respectively, only active timestamps, only inactive ones, +all of them or none. + +This option can also be set with the #+OPTIONS line, e.g. +\"<:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "All timestamps" t) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "No timestamp" nil))) + +(defcustom org-export-with-todo-keywords t + "Non-nil means include TODO keywords in export. +When nil, remove all these keywords from the export." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-allow-BIND 'confirm + "Non-nil means allow #+BIND to define local variable values for export. +This is a potential security risk, which is why the user must +confirm the use of these lines." + :group 'org-export-general + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Ask a confirmation for each file" confirm))) + +(defcustom org-export-snippet-translation-alist nil + "Alist between export snippets back-ends and exporter back-ends. + +This variable allows to provide shortcuts for export snippets. + +For example, with a value of '\(\(\"h\" . \"e-html\"\)\), the +HTML back-end will recognize the contents of \"@@h:<b>@@\" as +HTML code while every other back-end will ignore it." + :group 'org-export-general + :type '(repeat + (cons + (string :tag "Shortcut") + (string :tag "Back-end")))) + +(defcustom org-export-coding-system nil + "Coding system for the exported file." + :group 'org-export-general + :type 'coding-system) + +(defcustom org-export-copy-to-kill-ring t + "Non-nil means exported stuff will also be pushed onto the kill ring." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-initial-scope 'buffer + "The initial scope when exporting with `org-export-dispatch'. +This variable can be either set to `buffer' or `subtree'." + :group 'org-export-general + :type '(choice + (const :tag "Export current buffer" 'buffer) + (const :tag "Export current subtree" 'subtree))) + +(defcustom org-export-show-temporary-export-buffer t + "Non-nil means show buffer after exporting to temp buffer. +When Org exports to a file, the buffer visiting that file is ever +shown, but remains buried. However, when exporting to +a temporary buffer, that buffer is popped up in a second window. +When this variable is nil, the buffer remains buried also in +these cases." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-dispatch-use-expert-ui nil + "Non-nil means using a non-intrusive `org-export-dispatch'. +In that case, no help buffer is displayed. Though, an indicator +for current export scope is added to the prompt \(i.e. \"b\" when +output is restricted to body only, \"s\" when it is restricted to +the current subtree and \"v\" when only visible elements are +considered for export\). Also, \[?] allows to switch back to +standard mode." + :group 'org-export-general + :type 'boolean) + + + +;;; Defining New Back-ends + +(defmacro org-export-define-backend (backend translators &rest body) + "Define a new back-end BACKEND. + +TRANSLATORS is an alist between object or element types and +functions handling them. + +These functions should return a string without any trailing +space, or nil. They must accept three arguments: the object or +element itself, its contents or nil when it isn't recursive and +the property list used as a communication channel. + +Contents, when not nil, are stripped from any global indentation +\(although the relative one is preserved). They also always end +with a single newline character. + +If, for a given type, no function is found, that element or +object type will simply be ignored, along with any blank line or +white space at its end. The same will happen if the function +returns the nil value. If that function returns the empty +string, the type will be ignored, but the blank lines or white +spaces will be kept. + +In addition to element and object types, one function can be +associated to the `template' symbol and another one to the +`plain-text' symbol. + +The former returns the final transcoded string, and can be used +to add a preamble and a postamble to document's body. It must +accept two arguments: the transcoded string and the property list +containing export options. + +The latter, when defined, is to be called on every text not +recognized as an element or an object. It must accept two +arguments: the text string and the information channel. It is an +appropriate place to protect special chars relative to the +back-end. + +BODY can start with pre-defined keyword arguments. The following +keywords are understood: + + :export-block + + String, or list of strings, representing block names that + will not be parsed. This is used to specify blocks that will + contain raw code specific to the back-end. These blocks + still have to be handled by the relative `export-block' type + translator. + + :filters-alist + + Alist between filters and function, or list of functions, + specific to the back-end. See `org-export-filters-alist' for + a list of all allowed filters. Filters defined here + shouldn't make a back-end test, as it may prevent back-ends + derived from this one to behave properly. + + :options-alist + + Alist between back-end specific properties introduced in + communication channel and how their value are acquired. See + `org-export-options-alist' for more information about + structure of the values. + +As an example, here is how the `e-ascii' back-end is defined: + +\(org-export-define-backend e-ascii + \((bold . org-e-ascii-bold) + \(center-block . org-e-ascii-center-block) + \(clock . org-e-ascii-clock) + \(code . org-e-ascii-code) + \(drawer . org-e-ascii-drawer) + \(dynamic-block . org-e-ascii-dynamic-block) + \(entity . org-e-ascii-entity) + \(example-block . org-e-ascii-example-block) + \(export-block . org-e-ascii-export-block) + \(export-snippet . org-e-ascii-export-snippet) + \(fixed-width . org-e-ascii-fixed-width) + \(footnote-definition . org-e-ascii-footnote-definition) + \(footnote-reference . org-e-ascii-footnote-reference) + \(headline . org-e-ascii-headline) + \(horizontal-rule . org-e-ascii-horizontal-rule) + \(inline-src-block . org-e-ascii-inline-src-block) + \(inlinetask . org-e-ascii-inlinetask) + \(italic . org-e-ascii-italic) + \(item . org-e-ascii-item) + \(keyword . org-e-ascii-keyword) + \(latex-environment . org-e-ascii-latex-environment) + \(latex-fragment . org-e-ascii-latex-fragment) + \(line-break . org-e-ascii-line-break) + \(link . org-e-ascii-link) + \(macro . org-e-ascii-macro) + \(paragraph . org-e-ascii-paragraph) + \(plain-list . org-e-ascii-plain-list) + \(plain-text . org-e-ascii-plain-text) + \(planning . org-e-ascii-planning) + \(property-drawer . org-e-ascii-property-drawer) + \(quote-block . org-e-ascii-quote-block) + \(quote-section . org-e-ascii-quote-section) + \(radio-target . org-e-ascii-radio-target) + \(section . org-e-ascii-section) + \(special-block . org-e-ascii-special-block) + \(src-block . org-e-ascii-src-block) + \(statistics-cookie . org-e-ascii-statistics-cookie) + \(strike-through . org-e-ascii-strike-through) + \(subscript . org-e-ascii-subscript) + \(superscript . org-e-ascii-superscript) + \(table . org-e-ascii-table) + \(table-cell . org-e-ascii-table-cell) + \(table-row . org-e-ascii-table-row) + \(target . org-e-ascii-target) + \(template . org-e-ascii-template) + \(timestamp . org-e-ascii-timestamp) + \(underline . org-e-ascii-underline) + \(verbatim . org-e-ascii-verbatim) + \(verse-block . org-e-ascii-verse-block)) + :export-block \"ASCII\" + :filters-alist ((:filter-headline . org-e-ascii-filter-headline-blank-lines) + \(:filter-section . org-e-ascii-filter-headline-blank-lines)) + :options-alist ((:ascii-charset nil nil org-e-ascii-charset)))" + (declare (debug (&define name sexp [&rest [keywordp sexp]] defbody)) + (indent 1)) + (let (filters options export-block) + (while (keywordp (car body)) + (case (pop body) + (:export-block (let ((names (pop body))) + (setq export-block + (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) + (:filters-alist (setq filters (pop body))) + (:options-alist (setq options (pop body))) + (t (pop body)))) + `(progn + ;; Define translators. + (defvar ,(intern (format "org-%s-translate-alist" backend)) ',translators + "Alist between element or object types and translators.") + ;; Define options. + ,(when options + `(defconst ,(intern (format "org-%s-options-alist" backend)) ',options + ,(format "Alist between %s export properties and ways to set them. +See `org-export-options-alist' for more information on the +structure of the values." + backend))) + ;; Define filters. + ,(when filters + `(defconst ,(intern (format "org-%s-filters-alist" backend)) ',filters + "Alist between filters keywords and back-end specific filters. +See `org-export-filters-alist' for more information.")) + ;; Tell parser to not parse EXPORT-BLOCK blocks. + ,(when export-block + `(mapc + (lambda (name) + (add-to-list 'org-element-block-name-alist + `(,name . org-element-export-block-parser))) + ',export-block)) + ;; Splice in the body, if any. + ,@body))) + +(defmacro org-export-define-derived-backend (child parent &rest body) + "Create a new back-end as a variant of an existing one. + +CHILD is the name of the derived back-end. PARENT is the name of +the parent back-end. + +BODY can start with pre-defined keyword arguments. The following +keywords are understood: + + :export-block + + String, or list of strings, representing block names that + will not be parsed. This is used to specify blocks that will + contain raw code specific to the back-end. These blocks + still have to be handled by the relative `export-block' type + translator. + + :filters-alist + + Alist of filters that will overwrite or complete filters + defined in PARENT back-end. See `org-export-filters-alist' + for more a list of allowed filters. + + :options-alist + + Alist of back-end specific properties that will overwrite or + complete those defined in PARENT back-end. Refer to + `org-export-options-alist' for more information about + structure of the values. + + :translate-alist + + Alist of element and object types and transcoders that will + overwrite or complete transcode table from PARENT back-end. + Refer to `org-export-define-backend' for detailed information + about transcoders. + +As an example, here is how one could define \"my-latex\" back-end +as a variant of `e-latex' back-end with a custom template +function: + + \(org-export-define-derived-backend my-latex e-latex + :translate-alist ((template . my-latex-template-fun))) + +The back-end could then be called with, for example: + + \(org-export-to-buffer 'my-latex \"*Test my-latex*\")" + (declare (debug (&define name sexp [&rest [keywordp sexp]] def-body)) + (indent 2)) + (let (filters options translate export-block) + (while (keywordp (car body)) + (case (pop body) + (:export-block (let ((names (pop body))) + (setq export-block + (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) + (:filters-alist (setq filters (pop body))) + (:options-alist (setq options (pop body))) + (:translate-alist (setq translate (pop body))) + (t (pop body)))) + `(progn + ;; Tell parser to not parse EXPORT-BLOCK blocks. + ,(when export-block + `(mapc + (lambda (name) + (add-to-list 'org-element-block-name-alist + `(,name . org-element-export-block-parser))) + ',export-block)) + ;; Define filters. + ,(let ((parent-filters (intern (format "org-%s-filters-alist" parent)))) + (when (or (boundp parent-filters) filters) + `(defconst ,(intern (format "org-%s-filters-alist" child)) + ',(append filters + (and (boundp parent-filters) + (copy-sequence (symbol-value parent-filters)))) + "Alist between filters keywords and back-end specific filters. +See `org-export-filters-alist' for more information."))) + ;; Define options. + ,(let ((parent-options (intern (format "org-%s-options-alist" parent)))) + (when (or (boundp parent-options) options) + `(defconst ,(intern (format "org-%s-options-alist" child)) + ',(append options + (and (boundp parent-options) + (copy-sequence (symbol-value parent-options)))) + ,(format "Alist between %s export properties and ways to set them. +See `org-export-options-alist' for more information on the +structure of the values." + child)))) + ;; Define translators. + (defvar ,(intern (format "org-%s-translate-alist" child)) + ',(append translate + (copy-sequence + (symbol-value + (intern (format "org-%s-translate-alist" parent))))) + "Alist between element or object types and translators.") + ;; Splice in the body, if any. + ,@body))) + + + +;;; The Communication Channel +;; +;; During export process, every function has access to a number of +;; properties. They are of two types: +;; +;; 1. Environment options are collected once at the very beginning of +;; the process, out of the original buffer and configuration. +;; Collecting them is handled by `org-export-get-environment' +;; function. +;; +;; Most environment options are defined through the +;; `org-export-options-alist' variable. +;; +;; 2. Tree properties are extracted directly from the parsed tree, +;; just before export, by `org-export-collect-tree-properties'. +;; +;; Here is the full list of properties available during transcode +;; process, with their category (option, tree or local) and their +;; value type. +;; +;; + `:author' :: Author's name. +;; - category :: option +;; - type :: string +;; +;; + `:back-end' :: Current back-end used for transcoding. +;; - category :: tree +;; - type :: symbol +;; +;; + `:creator' :: String to write as creation information. +;; - category :: option +;; - type :: string +;; +;; + `:date' :: String to use as date. +;; - category :: option +;; - type :: string +;; +;; + `:description' :: Description text for the current data. +;; - category :: option +;; - type :: string +;; +;; + `:email' :: Author's email. +;; - category :: option +;; - type :: string +;; +;; + `:exclude-tags' :: Tags for exclusion of subtrees from export +;; process. +;; - category :: option +;; - type :: list of strings +;; +;; + `:exported-data' :: Hash table used for memoizing +;; `org-export-data'. +;; - category :: tree +;; - type :: hash table +;; +;; + `:footnote-definition-alist' :: Alist between footnote labels and +;; their definition, as parsed data. Only non-inlined footnotes +;; are represented in this alist. Also, every definition isn't +;; guaranteed to be referenced in the parse tree. The purpose of +;; this property is to preserve definitions from oblivion +;; (i.e. when the parse tree comes from a part of the original +;; buffer), it isn't meant for direct use in a back-end. To +;; retrieve a definition relative to a reference, use +;; `org-export-get-footnote-definition' instead. +;; - category :: option +;; - type :: alist (STRING . LIST) +;; +;; + `:headline-levels' :: Maximum level being exported as an +;; headline. Comparison is done with the relative level of +;; headlines in the parse tree, not necessarily with their +;; actual level. +;; - category :: option +;; - type :: integer +;; +;; + `:headline-offset' :: Difference between relative and real level +;; of headlines in the parse tree. For example, a value of -1 +;; means a level 2 headline should be considered as level +;; 1 (cf. `org-export-get-relative-level'). +;; - category :: tree +;; - type :: integer +;; +;; + `:headline-numbering' :: Alist between headlines and their +;; numbering, as a list of numbers +;; (cf. `org-export-get-headline-number'). +;; - category :: tree +;; - type :: alist (INTEGER . LIST) +;; +;; + `:id-alist' :: Alist between ID strings and destination file's +;; path, relative to current directory. It is used by +;; `org-export-resolve-id-link' to resolve ID links targeting an +;; external file. +;; - category :: option +;; - type :: alist (STRING . STRING) +;; +;; + `:ignore-list' :: List of elements and objects that should be +;; ignored during export. +;; - category :: tree +;; - type :: list of elements and objects +;; +;; + `:input-file' :: Full path to input file, if any. +;; - category :: option +;; - type :: string or nil +;; +;; + `:keywords' :: List of keywords attached to data. +;; - category :: option +;; - type :: string +;; +;; + `:language' :: Default language used for translations. +;; - category :: option +;; - type :: string +;; +;; + `:parse-tree' :: Whole parse tree, available at any time during +;; transcoding. +;; - category :: option +;; - type :: list (as returned by `org-element-parse-buffer') +;; +;; + `:preserve-breaks' :: Non-nil means transcoding should preserve +;; all line breaks. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:section-numbers' :: Non-nil means transcoding should add +;; section numbers to headlines. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:select-tags' :: List of tags enforcing inclusion of sub-trees +;; in transcoding. When such a tag is present, subtrees without +;; it are de facto excluded from the process. See +;; `use-select-tags'. +;; - category :: option +;; - type :: list of strings +;; +;; + `:target-list' :: List of targets encountered in the parse tree. +;; This is used to partly resolve "fuzzy" links +;; (cf. `org-export-resolve-fuzzy-link'). +;; - category :: tree +;; - type :: list of strings +;; +;; + `:time-stamp-file' :: Non-nil means transcoding should insert +;; a time stamp in the output. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:translate-alist' :: Alist between element and object types and +;; transcoding functions relative to the current back-end. +;; Special keys `template' and `plain-text' are also possible. +;; - category :: option +;; - type :: alist (SYMBOL . FUNCTION) +;; +;; + `:with-archived-trees' :: Non-nil when archived subtrees should +;; also be transcoded. If it is set to the `headline' symbol, +;; only the archived headline's name is retained. +;; - category :: option +;; - type :: symbol (nil, t, `headline') +;; +;; + `:with-author' :: Non-nil means author's name should be included +;; in the output. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-clocks' :: Non-nild means clock keywords should be exported. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-creator' :: Non-nild means a creation sentence should be +;; inserted at the end of the transcoded string. If the value +;; is `comment', it should be commented. +;; - category :: option +;; - type :: symbol (`comment', nil, t) +;; +;; + `:with-drawers' :: Non-nil means drawers should be exported. If +;; its value is a list of names, only drawers with such names +;; will be transcoded. +;; - category :: option +;; - type :: symbol (nil, t) or list of strings +;; +;; + `:with-email' :: Non-nil means output should contain author's +;; email. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-emphasize' :: Non-nil means emphasized text should be +;; interpreted. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-fixed-width' :: Non-nil if transcoder should interpret +;; strings starting with a colon as a fixed-with (verbatim) area. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-footnotes' :: Non-nil if transcoder should interpret +;; footnotes. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-plannings' :: Non-nil means transcoding should include +;; planning info. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-priority' :: Non-nil means transcoding should include +;; priority cookies. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-special-strings' :: Non-nil means transcoding should +;; interpret special strings in plain text. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-sub-superscript' :: Non-nil means transcoding should +;; interpret subscript and superscript. With a value of "{}", +;; only interpret those using curly brackets. +;; - category :: option +;; - type :: symbol (nil, {}, t) +;; +;; + `:with-tables' :: Non-nil means transcoding should interpret +;; tables. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-tags' :: Non-nil means transcoding should keep tags in +;; headlines. A `not-in-toc' value will remove them from the +;; table of contents, if any, nonetheless. +;; - category :: option +;; - type :: symbol (nil, t, `not-in-toc') +;; +;; + `:with-tasks' :: Non-nil means transcoding should include +;; headlines with a TODO keyword. A `todo' value will only +;; include headlines with a todo type keyword while a `done' +;; value will do the contrary. If a list of strings is provided, +;; only tasks with keywords belonging to that list will be kept. +;; - category :: option +;; - type :: symbol (t, todo, done, nil) or list of strings +;; +;; + `:with-timestamps' :: Non-nil means transcoding should include +;; time stamps. Special value `active' (resp. `inactive') ask to +;; export only active (resp. inactive) timestamps. Otherwise, +;; completely remove them. +;; - category :: option +;; - type :: symbol: (`active', `inactive', t, nil) +;; +;; + `:with-toc' :: Non-nil means that a table of contents has to be +;; added to the output. An integer value limits its depth. +;; - category :: option +;; - type :: symbol (nil, t or integer) +;; +;; + `:with-todo-keywords' :: Non-nil means transcoding should +;; include TODO keywords. +;; - category :: option +;; - type :: symbol (nil, t) + + +;;;; Environment Options +;; +;; Environment options encompass all parameters defined outside the +;; scope of the parsed data. They come from five sources, in +;; increasing precedence order: +;; +;; - Global variables, +;; - Buffer's attributes, +;; - Options keyword symbols, +;; - Buffer keywords, +;; - Subtree properties. +;; +;; The central internal function with regards to environment options +;; is `org-export-get-environment'. It updates global variables with +;; "#+BIND:" keywords, then retrieve and prioritize properties from +;; the different sources. +;; +;; The internal functions doing the retrieval are: +;; `org-export--get-global-options', +;; `org-export--get-buffer-attributes', +;; `org-export--parse-option-keyword', +;; `org-export--get-subtree-options' and +;; `org-export--get-inbuffer-options' +;; +;; Also, `org-export--confirm-letbind' and `org-export--install-letbind' +;; take care of the part relative to "#+BIND:" keywords. + +(defun org-export-get-environment (&optional backend subtreep ext-plist) + "Collect export options from the current buffer. + +Optional argument BACKEND is a symbol specifying which back-end +specific options to read, if any. + +When optional argument SUBTREEP is non-nil, assume the export is +done against the current sub-tree. + +Third optional argument EXT-PLIST is a property list with +external parameters overriding Org default settings, but still +inferior to file-local settings." + ;; First install #+BIND variables. + (org-export--install-letbind-maybe) + ;; Get and prioritize export options... + (org-combine-plists + ;; ... from global variables... + (org-export--get-global-options backend) + ;; ... from buffer's attributes... + (org-export--get-buffer-attributes) + ;; ... from an external property list... + ext-plist + ;; ... from in-buffer settings... + (org-export--get-inbuffer-options + backend + (and buffer-file-name (org-remove-double-quotes buffer-file-name))) + ;; ... and from subtree, when appropriate. + (and subtreep (org-export--get-subtree-options backend)) + ;; Eventually install back-end symbol and its translation table. + `(:back-end + ,backend + :translate-alist + ,(let ((trans-alist (intern (format "org-%s-translate-alist" backend)))) + (when (boundp trans-alist) (symbol-value trans-alist)))))) + +(defun org-export--parse-option-keyword (options &optional backend) + "Parse an OPTIONS line and return values as a plist. +Optional argument BACKEND is a symbol specifying which back-end +specific items to read, if any." + (let* ((all + (append org-export-options-alist + (and backend + (let ((var (intern + (format "org-%s-options-alist" backend)))) + (and (boundp var) (eval var)))))) + ;; Build an alist between #+OPTION: item and property-name. + (alist (delq nil + (mapcar (lambda (e) + (when (nth 2 e) (cons (regexp-quote (nth 2 e)) + (car e)))) + all))) + plist) + (mapc (lambda (e) + (when (string-match (concat "\\(\\`\\|[ \t]\\)" + (car e) + ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") + options) + (setq plist (plist-put plist + (cdr e) + (car (read-from-string + (match-string 2 options))))))) + alist) + plist)) + +(defun org-export--get-subtree-options (&optional backend) + "Get export options in subtree at point. +Optional argument BACKEND is a symbol specifying back-end used +for export. Return options as a plist." + ;; For each buffer keyword, create an headline property setting the + ;; same property in communication channel. The name for the property + ;; is the keyword with "EXPORT_" appended to it. + (org-with-wide-buffer + (let (prop plist) + ;; Make sure point is at an heading. + (unless (org-at-heading-p) (org-back-to-heading t)) + ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's + ;; title as its fallback value. + (when (setq prop (progn (looking-at org-todo-line-regexp) + (or (save-match-data + (org-entry-get (point) "EXPORT_TITLE")) + (org-match-string-no-properties 3)))) + (setq plist + (plist-put + plist :title + (org-element-parse-secondary-string + prop (org-element-restriction 'keyword))))) + ;; EXPORT_OPTIONS are parsed in a non-standard way. + (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS")) + (setq plist + (nconc plist (org-export--parse-option-keyword prop backend)))) + ;; Handle other keywords. + (let ((seen '("TITLE"))) + (mapc + (lambda (option) + (let ((property (nth 1 option))) + (when (and property (not (member property seen))) + (let* ((subtree-prop (concat "EXPORT_" property)) + ;; Export properties are not case-sensitive. + (value (let ((case-fold-search t)) + (org-entry-get (point) subtree-prop)))) + (push property seen) + (when value + (setq plist + (plist-put + plist + (car option) + ;; Parse VALUE if required. + (if (member property org-element-parsed-keywords) + (org-element-parse-secondary-string + value (org-element-restriction 'keyword)) + value)))))))) + ;; Also look for both general keywords and back-end specific + ;; options if BACKEND is provided. + (append (and backend + (let ((var (intern + (format "org-%s-options-alist" backend)))) + (and (boundp var) (symbol-value var)))) + org-export-options-alist))) + ;; Return value. + plist))) + +(defun org-export--get-inbuffer-options (&optional backend files) + "Return current buffer export options, as a plist. + +Optional argument BACKEND, when non-nil, is a symbol specifying +which back-end specific options should also be read in the +process. + +Optional argument FILES is a list of setup files names read so +far, used to avoid circular dependencies. + +Assume buffer is in Org mode. Narrowing, if any, is ignored." + (org-with-wide-buffer + (goto-char (point-min)) + (let ((case-fold-search t) plist) + ;; 1. Special keywords, as in `org-export-special-keywords'. + (let ((special-re (org-make-options-regexp org-export-special-keywords))) + (while (re-search-forward special-re nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let* ((key (org-element-property :key element)) + (val (org-element-property :value element)) + (prop + (cond + ((string= key "SETUP_FILE") + (let ((file + (expand-file-name + (org-remove-double-quotes (org-trim val))))) + ;; Avoid circular dependencies. + (unless (member file files) + (with-temp-buffer + (insert (org-file-contents file 'noerror)) + (org-mode) + (org-export--get-inbuffer-options + backend (cons file files)))))) + ((string= key "OPTIONS") + (org-export--parse-option-keyword val backend)) + ((string= key "MACRO") + (when (string-match + "^\\([-a-zA-Z0-9_]+\\)\\(?:[ \t]+\\(.*?\\)[ \t]*$\\)?" + val) + (let ((key + (intern + (concat ":macro-" + (downcase (match-string 1 val))))) + (value (org-match-string-no-properties 2 val))) + (cond + ((not value) nil) + ;; Value will be evaled: do not parse it. + ((string-match "\\`(eval\\>" value) + (list key (list value))) + ;; Value has to be parsed for nested + ;; macros. + (t + (list + key + (let ((restr (org-element-restriction 'macro))) + (org-element-parse-secondary-string + ;; If user explicitly asks for + ;; a newline, be sure to preserve it + ;; from further filling with + ;; `hard-newline'. Also replace + ;; "\\n" with "\n", "\\\n" with "\\n" + ;; and so on... + (replace-regexp-in-string + "\\(\\\\\\\\\\)n" "\\\\" + (replace-regexp-in-string + "\\(?:^\\|[^\\\\]\\)\\(\\\\n\\)" + hard-newline value nil nil 1) + nil nil 1) + restr))))))))))) + (setq plist (org-combine-plists plist prop))))))) + ;; 2. Standard options, as in `org-export-options-alist'. + (let* ((all (append org-export-options-alist + ;; Also look for back-end specific options + ;; if BACKEND is defined. + (and backend + (let ((var + (intern + (format "org-%s-options-alist" backend)))) + (and (boundp var) (eval var)))))) + ;; Build alist between keyword name and property name. + (alist + (delq nil (mapcar + (lambda (e) (when (nth 1 e) (cons (nth 1 e) (car e)))) + all))) + ;; Build regexp matching all keywords associated to export + ;; options. Note: the search is case insensitive. + (opt-re (org-make-options-regexp + (delq nil (mapcar (lambda (e) (nth 1 e)) all))))) + (goto-char (point-min)) + (while (re-search-forward opt-re nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let* ((key (org-element-property :key element)) + (val (org-element-property :value element)) + (prop (cdr (assoc key alist))) + (behaviour (nth 4 (assq prop all)))) + (setq plist + (plist-put + plist prop + ;; Handle value depending on specified BEHAVIOUR. + (case behaviour + (space + (if (not (plist-get plist prop)) (org-trim val) + (concat (plist-get plist prop) " " (org-trim val)))) + (newline + (org-trim + (concat (plist-get plist prop) "\n" (org-trim val)))) + (split + `(,@(plist-get plist prop) ,@(org-split-string val))) + ('t val) + (otherwise (if (not (plist-member plist prop)) val + (plist-get plist prop)))))))))) + ;; Parse keywords specified in `org-element-parsed-keywords'. + (mapc + (lambda (key) + (let* ((prop (cdr (assoc key alist))) + (value (and prop (plist-get plist prop)))) + (when (stringp value) + (setq plist + (plist-put + plist prop + (org-element-parse-secondary-string + value (org-element-restriction 'keyword))))))) + org-element-parsed-keywords)) + ;; 3. Return final value. + plist))) + +(defun org-export--get-buffer-attributes () + "Return properties related to buffer attributes, as a plist." + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (list + ;; Store full path of input file name, or nil. For internal use. + :input-file visited-file + :title (or (and visited-file + (file-name-sans-extension + (file-name-nondirectory visited-file))) + (buffer-name (buffer-base-buffer))) + :footnote-definition-alist + ;; Footnotes definitions must be collected in the original + ;; buffer, as there's no insurance that they will still be in the + ;; parse tree, due to possible narrowing. + (let (alist) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward org-footnote-definition-re nil t) + (let ((def (org-footnote-at-definition-p))) + (when def + (org-skip-whitespace) + (push (cons (car def) + (save-restriction + (narrow-to-region (point) (nth 2 def)) + ;; Like `org-element-parse-buffer', but + ;; makes sure the definition doesn't start + ;; with a section element. + (org-element--parse-elements + (point-min) (point-max) nil nil nil nil + (list 'org-data nil)))) + alist)))) + alist)) + :id-alist + ;; Collect id references. + (let (alist) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "\\[\\[id:\\(\\S-+?\\)\\]\\(?:\\[.*?\\]\\)?\\]" nil t) + (let* ((id (org-match-string-no-properties 1)) + (file (org-id-find-id-file id))) + (when file (push (cons id (file-relative-name file)) alist))))) + alist) + :macro-modification-time + (and visited-file + (file-exists-p visited-file) + (concat "(eval (format-time-string \"$1\" '" + (prin1-to-string (nth 5 (file-attributes visited-file))) + "))")) + ;; Store input file name as a macro. + :macro-input-file (and visited-file (file-name-nondirectory visited-file)) + ;; `:macro-date', `:macro-time' and `:macro-property' could as + ;; well be initialized as tree properties, since they don't + ;; depend on buffer properties. Though, it may be more logical + ;; to keep them close to other ":macro-" properties. + :macro-date "(eval (format-time-string \"$1\"))" + :macro-time "(eval (format-time-string \"$1\"))" + :macro-property "(eval (org-entry-get nil \"$1\" 'selective))"))) + +(defun org-export--get-global-options (&optional backend) + "Return global export options as a plist. + +Optional argument BACKEND, if non-nil, is a symbol specifying +which back-end specific export options should also be read in the +process." + (let ((all (append org-export-options-alist + (and backend + (let ((var (intern + (format "org-%s-options-alist" backend)))) + (and (boundp var) (symbol-value var)))))) + ;; Output value. + plist) + (mapc + (lambda (cell) + (setq plist + (plist-put + plist + (car cell) + ;; Eval default value provided. If keyword is a member + ;; of `org-element-parsed-keywords', parse it as + ;; a secondary string before storing it. + (let ((value (eval (nth 3 cell)))) + (if (not (stringp value)) value + (let ((keyword (nth 1 cell))) + (if (not (member keyword org-element-parsed-keywords)) value + (org-element-parse-secondary-string + value (org-element-restriction 'keyword))))))))) + all) + ;; Return value. + plist)) + +(defvar org-export--allow-BIND-local nil) +(defun org-export--confirm-letbind () + "Can we use #+BIND values during export? +By default this will ask for confirmation by the user, to divert +possible security risks." + (cond + ((not org-export-allow-BIND) nil) + ((eq org-export-allow-BIND t) t) + ((local-variable-p 'org-export--allow-BIND-local) + org-export--allow-BIND-local) + (t (org-set-local 'org-export--allow-BIND-local + (yes-or-no-p "Allow BIND values in this buffer? "))))) + +(defun org-export--install-letbind-maybe () + "Install the values from #+BIND lines as local variables. +Variables must be installed before in-buffer options are +retrieved." + (let (letbind pair) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward (org-make-options-regexp '("BIND")) nil t) + (when (org-export-confirm-letbind) + (push (read (concat "(" (org-match-string-no-properties 2) ")")) + letbind)))) + (while (setq pair (pop letbind)) + (org-set-local (car pair) (nth 1 pair))))) + + +;;;; Tree Properties +;; +;; Tree properties are infromation extracted from parse tree. They +;; are initialized at the beginning of the transcoding process by +;; `org-export-collect-tree-properties'. +;; +;; Dedicated functions focus on computing the value of specific tree +;; properties during initialization. Thus, +;; `org-export--populate-ignore-list' lists elements and objects that +;; should be skipped during export, `org-export--get-min-level' gets +;; the minimal exportable level, used as a basis to compute relative +;; level for headlines. Eventually +;; `org-export--collect-headline-numbering' builds an alist between +;; headlines and their numbering. + +(defun org-export-collect-tree-properties (data info) + "Extract tree properties from parse tree. + +DATA is the parse tree from which information is retrieved. INFO +is a list holding export options. + +Following tree properties are set or updated: + +`:exported-data' Hash table used to memoize results from + `org-export-data'. + +`:footnote-definition-alist' List of footnotes definitions in + original buffer and current parse tree. + +`:headline-offset' Offset between true level of headlines and + local level. An offset of -1 means an headline + of level 2 should be considered as a level + 1 headline in the context. + +`:headline-numbering' Alist of all headlines as key an the + associated numbering as value. + +`:ignore-list' List of elements that should be ignored during + export. + +`:target-list' List of all targets in the parse tree. + +Return updated plist." + ;; Install the parse tree in the communication channel, in order to + ;; use `org-export-get-genealogy' and al. + (setq info (plist-put info :parse-tree data)) + ;; Get the list of elements and objects to ignore, and put it into + ;; `:ignore-list'. Do not overwrite any user ignore that might have + ;; been done during parse tree filtering. + (setq info + (plist-put info + :ignore-list + (append (org-export--populate-ignore-list data info) + (plist-get info :ignore-list)))) + ;; Compute `:headline-offset' in order to be able to use + ;; `org-export-get-relative-level'. + (setq info + (plist-put info + :headline-offset + (- 1 (org-export--get-min-level data info)))) + ;; Update footnotes definitions list with definitions in parse tree. + ;; This is required since buffer expansion might have modified + ;; boundaries of footnote definitions contained in the parse tree. + ;; This way, definitions in `footnote-definition-alist' are bound to + ;; match those in the parse tree. + (let ((defs (plist-get info :footnote-definition-alist))) + (org-element-map + data 'footnote-definition + (lambda (fn) + (push (cons (org-element-property :label fn) + `(org-data nil ,@(org-element-contents fn))) + defs))) + (setq info (plist-put info :footnote-definition-alist defs))) + ;; Properties order doesn't matter: get the rest of the tree + ;; properties. + (nconc + `(:target-list + ,(org-element-map + data '(keyword target) + (lambda (blob) + (when (or (eq (org-element-type blob) 'target) + (string= (org-element-property :key blob) "TARGET")) + blob)) info) + :headline-numbering ,(org-export--collect-headline-numbering data info) + :exported-data ,(make-hash-table :test 'eq :size 4001)) + info)) + +(defun org-export--get-min-level (data options) + "Return minimum exportable headline's level in DATA. +DATA is parsed tree as returned by `org-element-parse-buffer'. +OPTIONS is a plist holding export options." + (catch 'exit + (let ((min-level 10000)) + (mapc + (lambda (blob) + (when (and (eq (org-element-type blob) 'headline) + (not (memq blob (plist-get options :ignore-list)))) + (setq min-level + (min (org-element-property :level blob) min-level))) + (when (= min-level 1) (throw 'exit 1))) + (org-element-contents data)) + ;; If no headline was found, for the sake of consistency, set + ;; minimum level to 1 nonetheless. + (if (= min-level 10000) 1 min-level)))) + +(defun org-export--collect-headline-numbering (data options) + "Return numbering of all exportable headlines in a parse tree. + +DATA is the parse tree. OPTIONS is the plist holding export +options. + +Return an alist whose key is an headline and value is its +associated numbering \(in the shape of a list of numbers\)." + (let ((numbering (make-vector org-export-max-depth 0))) + (org-element-map + data + 'headline + (lambda (headline) + (let ((relative-level + (1- (org-export-get-relative-level headline options)))) + (cons + headline + (loop for n across numbering + for idx from 0 to org-export-max-depth + when (< idx relative-level) collect n + when (= idx relative-level) collect (aset numbering idx (1+ n)) + when (> idx relative-level) do (aset numbering idx 0))))) + options))) + +(defun org-export--populate-ignore-list (data options) + "Return list of elements and objects to ignore during export. +DATA is the parse tree to traverse. OPTIONS is the plist holding +export options." + (let* (ignore + walk-data ; for byte-compiler. + (walk-data + (function + (lambda (data options selected) + ;; Collect ignored elements or objects into IGNORE-LIST. + (mapc + (lambda (el) + (if (org-export--skip-p el options selected) (push el ignore) + (let ((type (org-element-type el))) + (if (and (eq (plist-get options :with-archived-trees) + 'headline) + (eq (org-element-type el) 'headline) + (org-element-property :archivedp el)) + ;; If headline is archived but tree below has + ;; to be skipped, add it to ignore list. + (mapc (lambda (e) (push e ignore)) + (org-element-contents el)) + ;; Move into recursive objects/elements. + (when (org-element-contents el) + (funcall walk-data el options selected)))))) + (org-element-contents data)))))) + ;; Main call. First find trees containing a select tag, if any. + (funcall walk-data data options (org-export--selected-trees data options)) + ;; Return value. + ignore)) + +(defun org-export--selected-trees (data info) + "Return list of headlines containing a select tag in their tree. +DATA is parsed data as returned by `org-element-parse-buffer'. +INFO is a plist holding export options." + (let* (selected-trees + walk-data ; for byte-compiler. + (walk-data + (function + (lambda (data genealogy) + (case (org-element-type data) + (org-data (mapc (lambda (el) (funcall walk-data el genealogy)) + (org-element-contents data))) + (headline + (let ((tags (org-element-property :tags data))) + (if (loop for tag in (plist-get info :select-tags) + thereis (member tag tags)) + ;; When a select tag is found, mark full + ;; genealogy and every headline within the tree + ;; as acceptable. + (setq selected-trees + (append + genealogy + (org-element-map data 'headline 'identity) + selected-trees)) + ;; Else, continue searching in tree, recursively. + (mapc + (lambda (el) (funcall walk-data el (cons data genealogy))) + (org-element-contents data)))))))))) + (funcall walk-data data nil) selected-trees)) + +(defun org-export--skip-p (blob options selected) + "Non-nil when element or object BLOB should be skipped during export. +OPTIONS is the plist holding export options. SELECTED, when +non-nil, is a list of headlines belonging to a tree with a select +tag." + (case (org-element-type blob) + ;; Check headline. + (headline + (let ((with-tasks (plist-get options :with-tasks)) + (todo (org-element-property :todo-keyword blob)) + (todo-type (org-element-property :todo-type blob)) + (archived (plist-get options :with-archived-trees)) + (tags (org-element-property :tags blob))) + (or + ;; Ignore subtrees with an exclude tag. + (loop for k in (plist-get options :exclude-tags) + thereis (member k tags)) + ;; When a select tag is present in the buffer, ignore any tree + ;; without it. + (and selected (not (memq blob selected))) + ;; Ignore commented sub-trees. + (org-element-property :commentedp blob) + ;; Ignore archived subtrees if `:with-archived-trees' is nil. + (and (not archived) (org-element-property :archivedp blob)) + ;; Ignore tasks, if specified by `:with-tasks' property. + (and todo + (or (not with-tasks) + (and (memq with-tasks '(todo done)) + (not (eq todo-type with-tasks))) + (and (consp with-tasks) (not (member todo with-tasks)))))))) + ;; Check inlinetask. + (inlinetask (not (plist-get options :with-inlinetasks))) + ;; Check timestamp. + (timestamp + (case (plist-get options :with-timestamps) + ;; No timestamp allowed. + ('nil t) + ;; Only active timestamps allowed and the current one isn't + ;; active. + (active + (not (memq (org-element-property :type blob) + '(active active-range)))) + ;; Only inactive timestamps allowed and the current one isn't + ;; inactive. + (inactive + (not (memq (org-element-property :type blob) + '(inactive inactive-range)))))) + ;; Check drawer. + (drawer + (or (not (plist-get options :with-drawers)) + (and (consp (plist-get options :with-drawers)) + (not (member (org-element-property :drawer-name blob) + (plist-get options :with-drawers)))))) + ;; Check table-row. + (table-row (org-export-table-row-is-special-p blob options)) + ;; Check table-cell. + (table-cell + (and (org-export-table-has-special-column-p + (org-export-get-parent-table blob)) + (not (org-export-get-previous-element blob options)))) + ;; Check clock. + (clock (not (plist-get options :with-clocks))) + ;; Check planning. + (planning (not (plist-get options :with-plannings))))) + + + +;;; The Transcoder +;; +;; `org-export-data' reads a parse tree (obtained with, i.e. +;; `org-element-parse-buffer') and transcodes it into a specified +;; back-end output. It takes care of filtering out elements or +;; objects according to export options and organizing the output blank +;; lines and white space are preserved. The function memoizes its +;; results, so it is cheap to call it within translators. +;; +;; Internally, three functions handle the filtering of objects and +;; elements during the export. In particular, +;; `org-export-ignore-element' marks an element or object so future +;; parse tree traversals skip it, `org-export--interpret-p' tells which +;; elements or objects should be seen as real Org syntax and +;; `org-export-expand' transforms the others back into their original +;; shape +;; +;; `org-export-transcoder' is an accessor returning appropriate +;; translator function for a given element or object. + +(defun org-export-transcoder (blob info) + "Return appropriate transcoder for BLOB. +INFO is a plist containing export directives." + (let ((type (org-element-type blob))) + ;; Return contents only for complete parse trees. + (if (eq type 'org-data) (lambda (blob contents info) contents) + (let ((transcoder (cdr (assq type (plist-get info :translate-alist))))) + (and (functionp transcoder) transcoder))))) + +(defun org-export-data (data info) + "Convert DATA into current back-end format. + +DATA is a parse tree, an element or an object or a secondary +string. INFO is a plist holding export options. + +Return transcoded string." + (let ((memo (gethash data (plist-get info :exported-data) 'no-memo))) + (if (not (eq memo 'no-memo)) memo + (let* ((type (org-element-type data)) + (results + (cond + ;; Ignored element/object. + ((memq data (plist-get info :ignore-list)) nil) + ;; Plain text. + ((eq type 'plain-text) + (org-export-filter-apply-functions + (plist-get info :filter-plain-text) + (let ((transcoder (org-export-transcoder data info))) + (if transcoder (funcall transcoder data info) data)) + info)) + ;; Uninterpreted element/object: change it back to Org + ;; syntax and export again resulting raw string. + ((not (org-export--interpret-p data info)) + (org-export-data + (org-export-expand + data + (mapconcat (lambda (blob) (org-export-data blob info)) + (org-element-contents data) + "")) + info)) + ;; Secondary string. + ((not type) + (mapconcat (lambda (obj) (org-export-data obj info)) data "")) + ;; Element/Object without contents or, as a special case, + ;; headline with archive tag and archived trees restricted + ;; to title only. + ((or (not (org-element-contents data)) + (and (eq type 'headline) + (eq (plist-get info :with-archived-trees) 'headline) + (org-element-property :archivedp data))) + (let ((transcoder (org-export-transcoder data info))) + (and (functionp transcoder) + (funcall transcoder data nil info)))) + ;; Element/Object with contents. + (t + (let ((transcoder (org-export-transcoder data info))) + (when transcoder + (let* ((greaterp (memq type org-element-greater-elements)) + (objectp + (and (not greaterp) + (memq type org-element-recursive-objects))) + (contents + (mapconcat + (lambda (element) (org-export-data element info)) + (org-element-contents + (if (or greaterp objectp) data + ;; Elements directly containing objects + ;; must have their indentation normalized + ;; first. + (org-element-normalize-contents + data + ;; When normalizing contents of the first + ;; paragraph in an item or a footnote + ;; definition, ignore first line's + ;; indentation: there is none and it + ;; might be misleading. + (when (eq type 'paragraph) + (let ((parent (org-export-get-parent data))) + (and + (eq (car (org-element-contents parent)) + data) + (memq (org-element-type parent) + '(footnote-definition item)))))))) + ""))) + (funcall transcoder data + (if (not greaterp) contents + (org-element-normalize-string contents)) + info)))))))) + ;; Final result will be memoized before being returned. + (puthash + data + (cond + ((not results) nil) + ((memq type '(org-data plain-text nil)) results) + ;; Append the same white space between elements or objects as in + ;; the original buffer, and call appropriate filters. + (t + (let ((results + (org-export-filter-apply-functions + (plist-get info (intern (format ":filter-%s" type))) + (let ((post-blank (or (org-element-property :post-blank data) + 0))) + (if (memq type org-element-all-elements) + (concat (org-element-normalize-string results) + (make-string post-blank ?\n)) + (concat results (make-string post-blank ? )))) + info))) + results))) + (plist-get info :exported-data)))))) + +(defun org-export--interpret-p (blob info) + "Non-nil if element or object BLOB should be interpreted as Org syntax. +Check is done according to export options INFO, stored as +a plist." + (case (org-element-type blob) + ;; ... entities... + (entity (plist-get info :with-entities)) + ;; ... emphasis... + (emphasis (plist-get info :with-emphasize)) + ;; ... fixed-width areas. + (fixed-width (plist-get info :with-fixed-width)) + ;; ... footnotes... + ((footnote-definition footnote-reference) + (plist-get info :with-footnotes)) + ;; ... sub/superscripts... + ((subscript superscript) + (let ((sub/super-p (plist-get info :with-sub-superscript))) + (if (eq sub/super-p '{}) + (org-element-property :use-brackets-p blob) + sub/super-p))) + ;; ... tables... + (table (plist-get info :with-tables)) + (otherwise t))) + +(defun org-export-expand (blob contents) + "Expand a parsed element or object to its original state. +BLOB is either an element or an object. CONTENTS is its +contents, as a string or nil." + (funcall + (intern (format "org-element-%s-interpreter" (org-element-type blob))) + blob contents)) + +(defun org-export-ignore-element (element info) + "Add ELEMENT to `:ignore-list' in INFO. + +Any element in `:ignore-list' will be skipped when using +`org-element-map'. INFO is modified by side effects." + (plist-put info :ignore-list (cons element (plist-get info :ignore-list)))) + + + +;;; The Filter System +;; +;; Filters allow end-users to tweak easily the transcoded output. +;; They are the functional counterpart of hooks, as every filter in +;; a set is applied to the return value of the previous one. +;; +;; Every set is back-end agnostic. Although, a filter is always +;; called, in addition to the string it applies to, with the back-end +;; used as argument, so it's easy for the end-user to add back-end +;; specific filters in the set. The communication channel, as +;; a plist, is required as the third argument. +;; +;; From the developer side, filters sets can be installed in the +;; process with the help of `org-export-define-backend', which +;; internally sets `org-BACKEND-filters-alist' variable. Each +;; association has a key among the following symbols and a function or +;; a list of functions as value. +;; +;; - `:filter-parse-tree' applies directly on the complete parsed +;; tree. It's the only filters set that doesn't apply to a string. +;; Users can set it through `org-export-filter-parse-tree-functions' +;; variable. +;; +;; - `:filter-final-output' applies to the final transcoded string. +;; Users can set it with `org-export-filter-final-output-functions' +;; variable +;; +;; - `:filter-plain-text' applies to any string not recognized as Org +;; syntax. `org-export-filter-plain-text-functions' allows users to +;; configure it. +;; +;; - `:filter-TYPE' applies on the string returned after an element or +;; object of type TYPE has been transcoded. An user can modify +;; `org-export-filter-TYPE-functions' +;; +;; All filters sets are applied with +;; `org-export-filter-apply-functions' function. Filters in a set are +;; applied in a LIFO fashion. It allows developers to be sure that +;; their filters will be applied first. +;; +;; Filters properties are installed in communication channel with +;; `org-export-install-filters' function. +;; +;; Eventually, a hook (`org-export-before-parsing-hook') is run just +;; before parsing to allow for heavy structure modifications. + + +;;;; Before Parsing Hook + +(defvar org-export-before-parsing-hook nil + "Hook run before parsing an export buffer. + +This is run after include keywords have been expanded and Babel +code executed, on a copy of original buffer's area being +exported. Visibility is the same as in the original one. Point +is left at the beginning of the new one. + +Every function in this hook will be called with one argument: the +back-end currently used, as a symbol.") + + +;;;; Special Filters + +(defvar org-export-filter-parse-tree-functions nil + "List of functions applied to the parsed tree. +Each filter is called with three arguments: the parse tree, as +returned by `org-element-parse-buffer', the back-end, as +a symbol, and the communication channel, as a plist. It must +return the modified parse tree to transcode.") + +(defvar org-export-filter-final-output-functions nil + "List of functions applied to the transcoded string. +Each filter is called with three arguments: the full transcoded +string, the back-end, as a symbol, and the communication channel, +as a plist. It must return a string that will be used as the +final export output.") + +(defvar org-export-filter-plain-text-functions nil + "List of functions applied to plain text. +Each filter is called with three arguments: a string which +contains no Org syntax, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + + +;;;; Elements Filters + +(defvar org-export-filter-center-block-functions nil + "List of functions applied to a transcoded center block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-clock-functions nil + "List of functions applied to a transcoded clock. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-drawer-functions nil + "List of functions applied to a transcoded drawer. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-dynamic-block-functions nil + "List of functions applied to a transcoded dynamic-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-headline-functions nil + "List of functions applied to a transcoded headline. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inlinetask-functions nil + "List of functions applied to a transcoded inlinetask. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-plain-list-functions nil + "List of functions applied to a transcoded plain-list. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-item-functions nil + "List of functions applied to a transcoded item. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-comment-functions nil + "List of functions applied to a transcoded comment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-comment-block-functions nil + "List of functions applied to a transcoded comment-comment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-example-block-functions nil + "List of functions applied to a transcoded example-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-export-block-functions nil + "List of functions applied to a transcoded export-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-fixed-width-functions nil + "List of functions applied to a transcoded fixed-width. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-footnote-definition-functions nil + "List of functions applied to a transcoded footnote-definition. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-horizontal-rule-functions nil + "List of functions applied to a transcoded horizontal-rule. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-keyword-functions nil + "List of functions applied to a transcoded keyword. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-latex-environment-functions nil + "List of functions applied to a transcoded latex-environment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-babel-call-functions nil + "List of functions applied to a transcoded babel-call. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-paragraph-functions nil + "List of functions applied to a transcoded paragraph. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-planning-functions nil + "List of functions applied to a transcoded planning. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-property-drawer-functions nil + "List of functions applied to a transcoded property-drawer. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-quote-block-functions nil + "List of functions applied to a transcoded quote block. +Each filter is called with three arguments: the transcoded quote +data, as a string, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + +(defvar org-export-filter-quote-section-functions nil + "List of functions applied to a transcoded quote-section. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-section-functions nil + "List of functions applied to a transcoded section. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-special-block-functions nil + "List of functions applied to a transcoded special block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-src-block-functions nil + "List of functions applied to a transcoded src-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-functions nil + "List of functions applied to a transcoded table. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-cell-functions nil + "List of functions applied to a transcoded table-cell. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-row-functions nil + "List of functions applied to a transcoded table-row. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-verse-block-functions nil + "List of functions applied to a transcoded verse block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + + +;;;; Objects Filters + +(defvar org-export-filter-bold-functions nil + "List of functions applied to transcoded bold text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-code-functions nil + "List of functions applied to transcoded code text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-entity-functions nil + "List of functions applied to a transcoded entity. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-export-snippet-functions nil + "List of functions applied to a transcoded export-snippet. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-footnote-reference-functions nil + "List of functions applied to a transcoded footnote-reference. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inline-babel-call-functions nil + "List of functions applied to a transcoded inline-babel-call. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inline-src-block-functions nil + "List of functions applied to a transcoded inline-src-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-italic-functions nil + "List of functions applied to transcoded italic text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-latex-fragment-functions nil + "List of functions applied to a transcoded latex-fragment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-line-break-functions nil + "List of functions applied to a transcoded line-break. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-link-functions nil + "List of functions applied to a transcoded link. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-macro-functions nil + "List of functions applied to a transcoded macro. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-radio-target-functions nil + "List of functions applied to a transcoded radio-target. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-statistics-cookie-functions nil + "List of functions applied to a transcoded statistics-cookie. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-strike-through-functions nil + "List of functions applied to transcoded strike-through text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-subscript-functions nil + "List of functions applied to a transcoded subscript. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-superscript-functions nil + "List of functions applied to a transcoded superscript. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-target-functions nil + "List of functions applied to a transcoded target. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-timestamp-functions nil + "List of functions applied to a transcoded timestamp. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-underline-functions nil + "List of functions applied to transcoded underline text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-verbatim-functions nil + "List of functions applied to transcoded verbatim text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + + +;;;; Filters Tools +;; +;; Internal function `org-export-install-filters' installs filters +;; hard-coded in back-ends (developer filters) and filters from global +;; variables (user filters) in the communication channel. +;; +;; Internal function `org-export-filter-apply-functions' takes care +;; about applying each filter in order to a given data. It ignores +;; filters returning a nil value but stops whenever a filter returns +;; an empty string. + +(defun org-export-filter-apply-functions (filters value info) + "Call every function in FILTERS. + +Functions are called with arguments VALUE, current export +back-end and INFO. A function returning a nil value will be +skipped. If it returns the empty string, the process ends and +VALUE is ignored. + +Call is done in a LIFO fashion, to be sure that developer +specified filters, if any, are called first." + (catch 'exit + (dolist (filter filters value) + (let ((result (funcall filter value (plist-get info :back-end) info))) + (cond ((not value)) + ((equal value "") (throw 'exit nil)) + (t (setq value result))))))) + +(defun org-export-install-filters (info) + "Install filters properties in communication channel. + +INFO is a plist containing the current communication channel. + +Return the updated communication channel." + (let (plist) + ;; Install user defined filters with `org-export-filters-alist'. + (mapc (lambda (p) + (setq plist (plist-put plist (car p) (eval (cdr p))))) + org-export-filters-alist) + ;; Prepend back-end specific filters to that list. + (let ((back-end-filters (intern (format "org-%s-filters-alist" + (plist-get info :back-end))))) + (when (boundp back-end-filters) + (mapc (lambda (p) + ;; Single values get consed, lists are prepended. + (let ((key (car p)) (value (cdr p))) + (when value + (setq plist + (plist-put + plist key + (if (atom value) (cons value (plist-get plist key)) + (append value (plist-get plist key)))))))) + (eval back-end-filters)))) + ;; Return new communication channel. + (org-combine-plists info plist))) + + + +;;; Core functions +;; +;; This is the room for the main function, `org-export-as', along with +;; its derivatives, `org-export-to-buffer' and `org-export-to-file'. +;; They differ only by the way they output the resulting code. +;; +;; `org-export-output-file-name' is an auxiliary function meant to be +;; used with `org-export-to-file'. With a given extension, it tries +;; to provide a canonical file name to write export output to. +;; +;; Note that `org-export-as' doesn't really parse the current buffer, +;; but a copy of it (with the same buffer-local variables and +;; visibility), where include keywords are expanded and Babel blocks +;; are executed, if appropriate. +;; `org-export-with-current-buffer-copy' macro prepares that copy. +;; +;; File inclusion is taken care of by +;; `org-export-expand-include-keyword' and +;; `org-export--prepare-file-contents'. Structure wise, including +;; a whole Org file in a buffer often makes little sense. For +;; example, if the file contains an headline and the include keyword +;; was within an item, the item should contain the headline. That's +;; why file inclusion should be done before any structure can be +;; associated to the file, that is before parsing. + +(defun org-export-as + (backend &optional subtreep visible-only body-only ext-plist noexpand) + "Transcode current Org buffer into BACKEND code. + +If narrowing is active in the current buffer, only transcode its +narrowed part. + +If a region is active, transcode that region. + +When optional argument SUBTREEP is non-nil, transcode the +sub-tree at point, extracting information from the headline +properties first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only return body +code, without preamble nor postamble. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Optional argument NOEXPAND, when non-nil, prevents included files +to be expanded and Babel code to be executed. + +Return code as a string." + (save-excursion + (save-restriction + ;; Narrow buffer to an appropriate region or subtree for + ;; parsing. If parsing subtree, be sure to remove main headline + ;; too. + (cond ((org-region-active-p) + (narrow-to-region (region-beginning) (region-end))) + (subtreep + (org-narrow-to-subtree) + (goto-char (point-min)) + (forward-line) + (narrow-to-region (point) (point-max)))) + ;; 1. Get export environment from original buffer. Also install + ;; user's and developer's filters. + (let ((info (org-export-install-filters + (org-export-get-environment backend subtreep ext-plist))) + ;; 2. Get parse tree. Buffer isn't parsed directly. + ;; Instead, a temporary copy is created, where include + ;; keywords are expanded and code blocks are evaluated. + (tree (let ((buf (or (buffer-file-name (buffer-base-buffer)) + (current-buffer)))) + (org-export-with-current-buffer-copy + (unless noexpand + (org-export-expand-include-keyword) + ;; TODO: Setting `org-current-export-file' is + ;; required by Org Babel to properly resolve + ;; noweb references. Once "org-exp.el" is + ;; removed, modify + ;; `org-export-blocks-preprocess' so it accepts + ;; the value as an argument instead. + (let ((org-current-export-file buf)) + (org-export-blocks-preprocess))) + (goto-char (point-min)) + ;; Run hook + ;; `org-export-before-parsing-hook'. with current + ;; back-end as argument. + (run-hook-with-args + 'org-export-before-parsing-hook backend) + ;; Eventually parse buffer. + (org-element-parse-buffer nil visible-only))))) + ;; 3. Call parse-tree filters to get the final tree. + (setq tree + (org-export-filter-apply-functions + (plist-get info :filter-parse-tree) tree info)) + ;; 4. Now tree is complete, compute its properties and add + ;; them to communication channel. + (setq info + (org-combine-plists + info (org-export-collect-tree-properties tree info))) + ;; 5. Eventually transcode TREE. Wrap the resulting string + ;; into a template, if required. Eventually call + ;; final-output filter. + (let* ((body (org-element-normalize-string (org-export-data tree info))) + (template (cdr (assq 'template + (plist-get info :translate-alist)))) + (output (org-export-filter-apply-functions + (plist-get info :filter-final-output) + (if (or (not (functionp template)) body-only) body + (funcall template body info)) + info))) + ;; Maybe add final OUTPUT to kill ring, then return it. + (when org-export-copy-to-kill-ring (org-kill-new output)) + output))))) + +(defun org-export-to-buffer + (backend buffer &optional subtreep visible-only body-only ext-plist noexpand) + "Call `org-export-as' with output to a specified buffer. + +BACKEND is the back-end used for transcoding, as a symbol. + +BUFFER is the output buffer. If it already exists, it will be +erased first, otherwise, it will be created. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST +and NOEXPAND are similar to those used in `org-export-as', which +see. + +Return buffer." + (let ((out (org-export-as + backend subtreep visible-only body-only ext-plist noexpand)) + (buffer (get-buffer-create buffer))) + (with-current-buffer buffer + (erase-buffer) + (insert out) + (goto-char (point-min))) + buffer)) + +(defun org-export-to-file + (backend file &optional subtreep visible-only body-only ext-plist noexpand) + "Call `org-export-as' with output to a specified file. + +BACKEND is the back-end used for transcoding, as a symbol. FILE +is the name of the output file, as a string. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST +and NOEXPAND are similar to those used in `org-export-as', which +see. + +Return output file's name." + ;; Checks for FILE permissions. `write-file' would do the same, but + ;; we'd rather avoid needless transcoding of parse tree. + (unless (file-writable-p file) (error "Output file not writable")) + ;; Insert contents to a temporary buffer and write it to FILE. + (let ((out (org-export-as + backend subtreep visible-only body-only ext-plist noexpand))) + (with-temp-buffer + (insert out) + (let ((coding-system-for-write org-export-coding-system)) + (write-file file)))) + ;; Return full path. + file) + +(defun org-export-output-file-name (extension &optional subtreep pub-dir) + "Return output file's name according to buffer specifications. + +EXTENSION is a string representing the output file extension, +with the leading dot. + +With a non-nil optional argument SUBTREEP, try to determine +output file's name by looking for \"EXPORT_FILE_NAME\" property +of subtree at point. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Return file name as a string, or nil if it couldn't be +determined." + (let ((base-name + ;; File name may come from EXPORT_FILE_NAME subtree property, + ;; assuming point is at beginning of said sub-tree. + (file-name-sans-extension + (or (and subtreep + (org-entry-get + (save-excursion + (ignore-errors (org-back-to-heading) (point))) + "EXPORT_FILE_NAME" t)) + ;; File name may be extracted from buffer's associated + ;; file, if any. + (buffer-file-name (buffer-base-buffer)) + ;; Can't determine file name on our own: Ask user. + (let ((read-file-name-function + (and org-completion-use-ido 'ido-read-file-name))) + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (name) + (string= (file-name-extension name t) extension)))))))) + ;; Build file name. Enforce EXTENSION over whatever user may have + ;; come up with. PUB-DIR, if defined, always has precedence over + ;; any provided path. + (cond + (pub-dir + (concat (file-name-as-directory pub-dir) + (file-name-nondirectory base-name) + extension)) + ((string= (file-name-nondirectory base-name) base-name) + (concat (file-name-as-directory ".") base-name extension)) + (t (concat base-name extension))))) + +(defmacro org-export-with-current-buffer-copy (&rest body) + "Apply BODY in a copy of the current buffer. + +The copy preserves local variables and visibility of the original +buffer. + +Point is at buffer's beginning when BODY is applied." + (org-with-gensyms (original-buffer offset buffer-string overlays) + `(let ((,original-buffer (current-buffer)) + (,offset (1- (point-min))) + (,buffer-string (buffer-string)) + (,overlays (mapcar + 'copy-overlay (overlays-in (point-min) (point-max))))) + (with-temp-buffer + (let ((buffer-invisibility-spec nil)) + (org-clone-local-variables + ,original-buffer + "^\\(org-\\|orgtbl-\\|major-mode$\\|outline-\\(regexp\\|level\\)$\\)") + (insert ,buffer-string) + (mapc (lambda (ov) + (move-overlay + ov + (- (overlay-start ov) ,offset) + (- (overlay-end ov) ,offset) + (current-buffer))) + ,overlays) + (goto-char (point-min)) + (progn ,@body)))))) +(def-edebug-spec org-export-with-current-buffer-copy (body)) + +(defun org-export-expand-include-keyword (&optional included dir) + "Expand every include keyword in buffer. +Optional argument INCLUDED is a list of included file names along +with their line restriction, when appropriate. It is used to +avoid infinite recursion. Optional argument DIR is the current +working directory. It is used to properly resolve relative +paths." + (let ((case-fold-search t)) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+INCLUDE: \\(.*\\)" nil t) + (when (eq (org-element-type (save-match-data (org-element-at-point))) + 'keyword) + (beginning-of-line) + ;; Extract arguments from keyword's value. + (let* ((value (match-string 1)) + (ind (org-get-indentation)) + (file (and (string-match "^\"\\(\\S-+\\)\"" value) + (prog1 (expand-file-name (match-string 1 value) dir) + (setq value (replace-match "" nil nil value))))) + (lines + (and (string-match + ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" value) + (prog1 (match-string 1 value) + (setq value (replace-match "" nil nil value))))) + (env (cond ((string-match "\\<example\\>" value) 'example) + ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) + (match-string 1 value)))) + ;; Minimal level of included file defaults to the child + ;; level of the current headline, if any, or one. It + ;; only applies is the file is meant to be included as + ;; an Org one. + (minlevel + (and (not env) + (if (string-match ":minlevel +\\([0-9]+\\)" value) + (prog1 (string-to-number (match-string 1 value)) + (setq value (replace-match "" nil nil value))) + (let ((cur (org-current-level))) + (if cur (1+ (org-reduced-level cur)) 1)))))) + ;; Remove keyword. + (delete-region (point) (progn (forward-line) (point))) + (cond + ((not (file-readable-p file)) (error "Cannot include file %s" file)) + ;; Check if files has already been parsed. Look after + ;; inclusion lines too, as different parts of the same file + ;; can be included too. + ((member (list file lines) included) + (error "Recursive file inclusion: %s" file)) + (t + (cond + ((eq env 'example) + (insert + (let ((ind-str (make-string ind ? )) + (contents + ;; Protect sensitive contents with commas. + (replace-regexp-in-string + "\\(^\\)\\([*]\\|[ \t]*#\\+\\)" "," + (org-export--prepare-file-contents file lines) + nil nil 1))) + (format "%s#+BEGIN_EXAMPLE\n%s%s#+END_EXAMPLE\n" + ind-str contents ind-str)))) + ((stringp env) + (insert + (let ((ind-str (make-string ind ? )) + (contents + ;; Protect sensitive contents with commas. + (replace-regexp-in-string + (if (string= env "org") "\\(^\\)\\(.\\)" + "\\(^\\)\\([*]\\|[ \t]*#\\+\\)") "," + (org-export--prepare-file-contents file lines) + nil nil 1))) + (format "%s#+BEGIN_SRC %s\n%s%s#+END_SRC\n" + ind-str env contents ind-str)))) + (t + (insert + (with-temp-buffer + (org-mode) + (insert + (org-export--prepare-file-contents file lines ind minlevel)) + (org-export-expand-include-keyword + (cons (list file lines) included) + (file-name-directory file)) + (buffer-string)))))))))))) + +(defun org-export--prepare-file-contents (file &optional lines ind minlevel) + "Prepare the contents of FILE for inclusion and return them as a string. + +When optional argument LINES is a string specifying a range of +lines, include only those lines. + +Optional argument IND, when non-nil, is an integer specifying the +global indentation of returned contents. Since its purpose is to +allow an included file to stay in the same environment it was +created \(i.e. a list item), it doesn't apply past the first +headline encountered. + +Optional argument MINLEVEL, when non-nil, is an integer +specifying the level that any top-level headline in the included +file should have." + (with-temp-buffer + (insert-file-contents file) + (when lines + (let* ((lines (split-string lines "-")) + (lbeg (string-to-number (car lines))) + (lend (string-to-number (cadr lines))) + (beg (if (zerop lbeg) (point-min) + (goto-char (point-min)) + (forward-line (1- lbeg)) + (point))) + (end (if (zerop lend) (point-max) + (goto-char (point-min)) + (forward-line (1- lend)) + (point)))) + (narrow-to-region beg end))) + ;; Remove blank lines at beginning and end of contents. The logic + ;; behind that removal is that blank lines around include keyword + ;; override blank lines in included file. + (goto-char (point-min)) + (org-skip-whitespace) + (beginning-of-line) + (delete-region (point-min) (point)) + (goto-char (point-max)) + (skip-chars-backward " \r\t\n") + (forward-line) + (delete-region (point) (point-max)) + ;; If IND is set, preserve indentation of include keyword until + ;; the first headline encountered. + (when ind + (unless (eq major-mode 'org-mode) (org-mode)) + (goto-char (point-min)) + (let ((ind-str (make-string ind ? ))) + (while (not (or (eobp) (looking-at org-outline-regexp-bol))) + ;; Do not move footnote definitions out of column 0. + (unless (and (looking-at org-footnote-definition-re) + (eq (org-element-type (org-element-at-point)) + 'footnote-definition)) + (insert ind-str)) + (forward-line)))) + ;; When MINLEVEL is specified, compute minimal level for headlines + ;; in the file (CUR-MIN), and remove stars to each headline so + ;; that headlines with minimal level have a level of MINLEVEL. + (when minlevel + (unless (eq major-mode 'org-mode) (org-mode)) + (let ((levels (org-map-entries + (lambda () (org-reduced-level (org-current-level)))))) + (when levels + (let ((offset (- minlevel (apply 'min levels)))) + (unless (zerop offset) + (when org-odd-levels-only (setq offset (* offset 2))) + ;; Only change stars, don't bother moving whole + ;; sections. + (org-map-entries + (lambda () (if (< offset 0) (delete-char (abs offset)) + (insert (make-string offset ?*)))))))))) + (buffer-string))) + + +;;; Tools For Back-Ends +;; +;; A whole set of tools is available to help build new exporters. Any +;; function general enough to have its use across many back-ends +;; should be added here. +;; +;; As of now, functions operating on footnotes, headlines, links, +;; macros, references, src-blocks, tables and tables of contents are +;; implemented. + +;;;; For Affiliated Keywords +;; +;; `org-export-read-attribute' reads a property from a given element +;; as a plist. It can be used to normalize affiliated keywords' +;; syntax. + +(defun org-export-read-attribute (attribute element &optional property) + "Turn ATTRIBUTE property from ELEMENT into a plist. + +When optional argument PROPERTY is non-nil, return the value of +that property within attributes. + +This function assumes attributes are defined as \":keyword +value\" pairs. It is appropriate for `:attr_html' like +properties." + (let ((attributes + (let ((value (org-element-property attribute element))) + (and value + (read (format "(%s)" (mapconcat 'identity value " "))))))) + (if property (plist-get attributes property) attributes))) + + +;;;; For Export Snippets +;; +;; Every export snippet is transmitted to the back-end. Though, the +;; latter will only retain one type of export-snippet, ignoring +;; others, based on the former's target back-end. The function +;; `org-export-snippet-backend' returns that back-end for a given +;; export-snippet. + +(defun org-export-snippet-backend (export-snippet) + "Return EXPORT-SNIPPET targeted back-end as a symbol. +Translation, with `org-export-snippet-translation-alist', is +applied." + (let ((back-end (org-element-property :back-end export-snippet))) + (intern + (or (cdr (assoc back-end org-export-snippet-translation-alist)) + back-end)))) + + +;;;; For Footnotes +;; +;; `org-export-collect-footnote-definitions' is a tool to list +;; actually used footnotes definitions in the whole parse tree, or in +;; an headline, in order to add footnote listings throughout the +;; transcoded data. +;; +;; `org-export-footnote-first-reference-p' is a predicate used by some +;; back-ends, when they need to attach the footnote definition only to +;; the first occurrence of the corresponding label. +;; +;; `org-export-get-footnote-definition' and +;; `org-export-get-footnote-number' provide easier access to +;; additional information relative to a footnote reference. + +(defun org-export-collect-footnote-definitions (data info) + "Return an alist between footnote numbers, labels and definitions. + +DATA is the parse tree from which definitions are collected. +INFO is the plist used as a communication channel. + +Definitions are sorted by order of references. They either +appear as Org data or as a secondary string for inlined +footnotes. Unreferenced definitions are ignored." + (let* (num-alist + collect-fn ; for byte-compiler. + (collect-fn + (function + (lambda (data) + ;; Collect footnote number, label and definition in DATA. + (org-element-map + data 'footnote-reference + (lambda (fn) + (when (org-export-footnote-first-reference-p fn info) + (let ((def (org-export-get-footnote-definition fn info))) + (push + (list (org-export-get-footnote-number fn info) + (org-element-property :label fn) + def) + num-alist) + ;; Also search in definition for nested footnotes. + (when (eq (org-element-property :type fn) 'standard) + (funcall collect-fn def))))) + ;; Don't enter footnote definitions since it will happen + ;; when their first reference is found. + info nil 'footnote-definition))))) + (funcall collect-fn (plist-get info :parse-tree)) + (reverse num-alist))) + +(defun org-export-footnote-first-reference-p (footnote-reference info) + "Non-nil when a footnote reference is the first one for its label. + +FOOTNOTE-REFERENCE is the footnote reference being considered. +INFO is the plist used as a communication channel." + (let ((label (org-element-property :label footnote-reference))) + ;; Anonymous footnotes are always a first reference. + (if (not label) t + ;; Otherwise, return the first footnote with the same LABEL and + ;; test if it is equal to FOOTNOTE-REFERENCE. + (let* (search-refs ; for byte-compiler. + (search-refs + (function + (lambda (data) + (org-element-map + data 'footnote-reference + (lambda (fn) + (cond + ((string= (org-element-property :label fn) label) + (throw 'exit fn)) + ;; If FN isn't inlined, be sure to traverse its + ;; definition before resuming search. See + ;; comments in `org-export-get-footnote-number' + ;; for more information. + ((eq (org-element-property :type fn) 'standard) + (funcall search-refs + (org-export-get-footnote-definition fn info))))) + ;; Don't enter footnote definitions since it will + ;; happen when their first reference is found. + info 'first-match 'footnote-definition))))) + (eq (catch 'exit (funcall search-refs (plist-get info :parse-tree))) + footnote-reference))))) + +(defun org-export-get-footnote-definition (footnote-reference info) + "Return definition of FOOTNOTE-REFERENCE as parsed data. +INFO is the plist used as a communication channel." + (let ((label (org-element-property :label footnote-reference))) + (or (org-element-property :inline-definition footnote-reference) + (cdr (assoc label (plist-get info :footnote-definition-alist)))))) + +(defun org-export-get-footnote-number (footnote info) + "Return number associated to a footnote. + +FOOTNOTE is either a footnote reference or a footnote definition. +INFO is the plist used as a communication channel." + (let* ((label (org-element-property :label footnote)) + seen-refs + search-ref ; For byte-compiler. + (search-ref + (function + (lambda (data) + ;; Search footnote references through DATA, filling + ;; SEEN-REFS along the way. + (org-element-map + data 'footnote-reference + (lambda (fn) + (let ((fn-lbl (org-element-property :label fn))) + (cond + ;; Anonymous footnote match: return number. + ((and (not fn-lbl) (eq fn footnote)) + (throw 'exit (1+ (length seen-refs)))) + ;; Labels match: return number. + ((and label (string= label fn-lbl)) + (throw 'exit (1+ (length seen-refs)))) + ;; Anonymous footnote: it's always a new one. Also, + ;; be sure to return nil from the `cond' so + ;; `first-match' doesn't get us out of the loop. + ((not fn-lbl) (push 'inline seen-refs) nil) + ;; Label not seen so far: add it so SEEN-REFS. + ;; + ;; Also search for subsequent references in + ;; footnote definition so numbering follows reading + ;; logic. Note that we don't have to care about + ;; inline definitions, since `org-element-map' + ;; already traverses them at the right time. + ;; + ;; Once again, return nil to stay in the loop. + ((not (member fn-lbl seen-refs)) + (push fn-lbl seen-refs) + (funcall search-ref + (org-export-get-footnote-definition fn info)) + nil)))) + ;; Don't enter footnote definitions since it will happen + ;; when their first reference is found. + info 'first-match 'footnote-definition))))) + (catch 'exit (funcall search-ref (plist-get info :parse-tree))))) + + +;;;; For Headlines +;; +;; `org-export-get-relative-level' is a shortcut to get headline +;; level, relatively to the lower headline level in the parsed tree. +;; +;; `org-export-get-headline-number' returns the section number of an +;; headline, while `org-export-number-to-roman' allows to convert it +;; to roman numbers. +;; +;; `org-export-low-level-p', `org-export-first-sibling-p' and +;; `org-export-last-sibling-p' are three useful predicates when it +;; comes to fulfill the `:headline-levels' property. + +(defun org-export-get-relative-level (headline info) + "Return HEADLINE relative level within current parsed tree. +INFO is a plist holding contextual information." + (+ (org-element-property :level headline) + (or (plist-get info :headline-offset) 0))) + +(defun org-export-low-level-p (headline info) + "Non-nil when HEADLINE is considered as low level. + +INFO is a plist used as a communication channel. + +A low level headlines has a relative level greater than +`:headline-levels' property value. + +Return value is the difference between HEADLINE relative level +and the last level being considered as high enough, or nil." + (let ((limit (plist-get info :headline-levels))) + (when (wholenump limit) + (let ((level (org-export-get-relative-level headline info))) + (and (> level limit) (- level limit)))))) + +(defun org-export-get-headline-number (headline info) + "Return HEADLINE numbering as a list of numbers. +INFO is a plist holding contextual information." + (cdr (assoc headline (plist-get info :headline-numbering)))) + +(defun org-export-numbered-headline-p (headline info) + "Return a non-nil value if HEADLINE element should be numbered. +INFO is a plist used as a communication channel." + (let ((sec-num (plist-get info :section-numbers)) + (level (org-export-get-relative-level headline info))) + (if (wholenump sec-num) (<= level sec-num) sec-num))) + +(defun org-export-number-to-roman (n) + "Convert integer N into a roman numeral." + (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") + ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL") + ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV") + ( 1 . "I"))) + (res "")) + (if (<= n 0) + (number-to-string n) + (while roman + (if (>= n (caar roman)) + (setq n (- n (caar roman)) + res (concat res (cdar roman))) + (pop roman))) + res))) + +(defun org-export-get-tags (element info &optional tags) + "Return list of tags associated to ELEMENT. + +ELEMENT has either an `headline' or an `inlinetask' type. INFO +is a plist used as a communication channel. + +Select tags (see `org-export-select-tags') and exclude tags (see +`org-export-exclude-tags') are removed from the list. + +When non-nil, optional argument TAGS should be a list of strings. +Any tag belonging to this list will also be removed." + (org-remove-if (lambda (tag) (or (member tag (plist-get info :select-tags)) + (member tag (plist-get info :exclude-tags)) + (member tag tags))) + (org-element-property :tags element))) + +(defun org-export-first-sibling-p (headline info) + "Non-nil when HEADLINE is the first sibling in its sub-tree. +INFO is a plist used as a communication channel." + (not (eq (org-element-type (org-export-get-previous-element headline info)) + 'headline))) + +(defun org-export-last-sibling-p (headline info) + "Non-nil when HEADLINE is the last sibling in its sub-tree. +INFO is a plist used as a communication channel." + (not (org-export-get-next-element headline info))) + + +;;;; For Links +;; +;; `org-export-solidify-link-text' turns a string into a safer version +;; for links, replacing most non-standard characters with hyphens. +;; +;; `org-export-get-coderef-format' returns an appropriate format +;; string for coderefs. +;; +;; `org-export-inline-image-p' returns a non-nil value when the link +;; provided should be considered as an inline image. +;; +;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links +;; (i.e. links with "fuzzy" as type) within the parsed tree, and +;; returns an appropriate unique identifier when found, or nil. +;; +;; `org-export-resolve-id-link' returns the first headline with +;; specified id or custom-id in parse tree, the path to the external +;; file with the id or nil when neither was found. +;; +;; `org-export-resolve-coderef' associates a reference to a line +;; number in the element it belongs, or returns the reference itself +;; when the element isn't numbered. + +(defun org-export-solidify-link-text (s) + "Take link text S and make a safe target out of it." + (save-match-data + (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-]+") "-"))) + +(defun org-export-get-coderef-format (path desc) + "Return format string for code reference link. +PATH is the link path. DESC is its description." + (save-match-data + (cond ((not desc) "%s") + ((string-match (regexp-quote (concat "(" path ")")) desc) + (replace-match "%s" t t desc)) + (t desc)))) + +(defun org-export-inline-image-p (link &optional rules) + "Non-nil if LINK object points to an inline image. + +Optional argument is a set of RULES defining inline images. It +is an alist where associations have the following shape: + + \(TYPE . REGEXP) + +Applying a rule means apply REGEXP against LINK's path when its +type is TYPE. The function will return a non-nil value if any of +the provided rules is non-nil. The default rule is +`org-export-default-inline-image-rule'. + +This only applies to links without a description." + (and (not (org-element-contents link)) + (let ((case-fold-search t) + (rules (or rules org-export-default-inline-image-rule))) + (catch 'exit + (mapc + (lambda (rule) + (and (string= (org-element-property :type link) (car rule)) + (string-match (cdr rule) + (org-element-property :path link)) + (throw 'exit t))) + rules) + ;; Return nil if no rule matched. + nil)))) + +(defun org-export-resolve-coderef (ref info) + "Resolve a code reference REF. + +INFO is a plist used as a communication channel. + +Return associated line number in source code, or REF itself, +depending on src-block or example element's switches." + (org-element-map + (plist-get info :parse-tree) '(example-block src-block) + (lambda (el) + (with-temp-buffer + (insert (org-trim (org-element-property :value el))) + (let* ((label-fmt (regexp-quote + (or (org-element-property :label-fmt el) + org-coderef-label-format))) + (ref-re + (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$" + (replace-regexp-in-string "%s" ref label-fmt nil t)))) + ;; Element containing REF is found. Resolve it to either + ;; a label or a line number, as needed. + (when (re-search-backward ref-re nil t) + (cond + ((org-element-property :use-labels el) ref) + ((eq (org-element-property :number-lines el) 'continued) + (+ (org-export-get-loc el info) (line-number-at-pos))) + (t (line-number-at-pos))))))) + info 'first-match)) + +(defun org-export-resolve-fuzzy-link (link info) + "Return LINK destination. + +INFO is a plist holding contextual information. + +Return value can be an object, an element, or nil: + +- If LINK path matches a target object (i.e. <<path>>) or + element (i.e. \"#+TARGET: path\"), return it. + +- If LINK path exactly matches the name affiliated keyword + \(i.e. #+NAME: path) of an element, return that element. + +- If LINK path exactly matches any headline name, return that + element. If more than one headline share that name, priority + will be given to the one with the closest common ancestor, if + any, or the first one in the parse tree otherwise. + +- Otherwise, return nil. + +Assume LINK type is \"fuzzy\"." + (let* ((path (org-element-property :path link)) + (match-title-p (eq (aref path 0) ?*))) + (cond + ;; First try to find a matching "<<path>>" unless user specified + ;; he was looking for an headline (path starts with a * + ;; character). + ((and (not match-title-p) + (loop for target in (plist-get info :target-list) + when (string= (org-element-property :value target) path) + return target))) + ;; Then try to find an element with a matching "#+NAME: path" + ;; affiliated keyword. + ((and (not match-title-p) + (org-element-map + (plist-get info :parse-tree) org-element-all-elements + (lambda (el) + (when (string= (org-element-property :name el) path) el)) + info 'first-match))) + ;; Last case: link either points to an headline or to + ;; nothingness. Try to find the source, with priority given to + ;; headlines with the closest common ancestor. If such candidate + ;; is found, return it, otherwise return nil. + (t + (let ((find-headline + (function + ;; Return first headline whose `:raw-value' property + ;; is NAME in parse tree DATA, or nil. + (lambda (name data) + (org-element-map + data 'headline + (lambda (headline) + (when (string= + (org-element-property :raw-value headline) + name) + headline)) + info 'first-match))))) + ;; Search among headlines sharing an ancestor with link, + ;; from closest to farthest. + (or (catch 'exit + (mapc + (lambda (parent) + (when (eq (org-element-type parent) 'headline) + (let ((foundp (funcall find-headline path parent))) + (when foundp (throw 'exit foundp))))) + (org-export-get-genealogy link)) nil) + ;; No match with a common ancestor: try the full parse-tree. + (funcall find-headline + (if match-title-p (substring path 1) path) + (plist-get info :parse-tree)))))))) + +(defun org-export-resolve-id-link (link info) + "Return headline referenced as LINK destination. + +INFO is a plist used as a communication channel. + +Return value can be the headline element matched in current parse +tree, a file name or nil. Assume LINK type is either \"id\" or +\"custom-id\"." + (let ((id (org-element-property :path link))) + ;; First check if id is within the current parse tree. + (or (org-element-map + (plist-get info :parse-tree) 'headline + (lambda (headline) + (when (or (string= (org-element-property :id headline) id) + (string= (org-element-property :custom-id headline) id)) + headline)) + info 'first-match) + ;; Otherwise, look for external files. + (cdr (assoc id (plist-get info :id-alist)))))) + +(defun org-export-resolve-radio-link (link info) + "Return radio-target object referenced as LINK destination. + +INFO is a plist used as a communication channel. + +Return value can be a radio-target object or nil. Assume LINK +has type \"radio\"." + (let ((path (org-element-property :path link))) + (org-element-map + (plist-get info :parse-tree) 'radio-target + (lambda (radio) + (when (equal (org-element-property :value radio) path) radio)) + info 'first-match))) + + +;;;; For Macros +;; +;; `org-export-expand-macro' simply takes care of expanding macros. + +(defun org-export-expand-macro (macro info) + "Expand MACRO and return it as a string. +INFO is a plist holding export options." + (let* ((key (org-element-property :key macro)) + (args (org-element-property :args macro)) + ;; User's macros are stored in the communication channel with + ;; a ":macro-" prefix. Replace arguments in VALUE. Also + ;; expand recursively macros within. + (value (org-export-data + (mapcar + (lambda (obj) + (if (not (stringp obj)) (org-export-data obj info) + (replace-regexp-in-string + "\\$[0-9]+" + (lambda (arg) + (nth (1- (string-to-number (substring arg 1))) args)) + obj))) + (plist-get info (intern (format ":macro-%s" key)))) + info))) + ;; VALUE starts with "(eval": it is a s-exp, `eval' it. + (when (string-match "\\`(eval\\>" value) (setq value (eval (read value)))) + ;; Return string. + (format "%s" (or value "")))) + + +;;;; For References +;; +;; `org-export-get-ordinal' associates a sequence number to any object +;; or element. + +(defun org-export-get-ordinal (element info &optional types predicate) + "Return ordinal number of an element or object. + +ELEMENT is the element or object considered. INFO is the plist +used as a communication channel. + +Optional argument TYPES, when non-nil, is a list of element or +object types, as symbols, that should also be counted in. +Otherwise, only provided element's type is considered. + +Optional argument PREDICATE is a function returning a non-nil +value if the current element or object should be counted in. It +accepts two arguments: the element or object being considered and +the plist used as a communication channel. This allows to count +only a certain type of objects (i.e. inline images). + +Return value is a list of numbers if ELEMENT is an headline or an +item. It is nil for keywords. It represents the footnote number +for footnote definitions and footnote references. If ELEMENT is +a target, return the same value as if ELEMENT was the closest +table, item or headline containing the target. In any other +case, return the sequence number of ELEMENT among elements or +objects of the same type." + ;; A target keyword, representing an invisible target, never has + ;; a sequence number. + (unless (eq (org-element-type element) 'keyword) + ;; Ordinal of a target object refer to the ordinal of the closest + ;; table, item, or headline containing the object. + (when (eq (org-element-type element) 'target) + (setq element + (loop for parent in (org-export-get-genealogy element) + when + (memq + (org-element-type parent) + '(footnote-definition footnote-reference headline item + table)) + return parent))) + (case (org-element-type element) + ;; Special case 1: An headline returns its number as a list. + (headline (org-export-get-headline-number element info)) + ;; Special case 2: An item returns its number as a list. + (item (let ((struct (org-element-property :structure element))) + (org-list-get-item-number + (org-element-property :begin element) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct)))) + ((footnote-definition footnote-reference) + (org-export-get-footnote-number element info)) + (otherwise + (let ((counter 0)) + ;; Increment counter until ELEMENT is found again. + (org-element-map + (plist-get info :parse-tree) (or types (org-element-type element)) + (lambda (el) + (cond + ((eq element el) (1+ counter)) + ((not predicate) (incf counter) nil) + ((funcall predicate el info) (incf counter) nil))) + info 'first-match)))))) + + +;;;; For Src-Blocks +;; +;; `org-export-get-loc' counts number of code lines accumulated in +;; src-block or example-block elements with a "+n" switch until +;; a given element, excluded. Note: "-n" switches reset that count. +;; +;; `org-export-unravel-code' extracts source code (along with a code +;; references alist) from an `element-block' or `src-block' type +;; element. +;; +;; `org-export-format-code' applies a formatting function to each line +;; of code, providing relative line number and code reference when +;; appropriate. Since it doesn't access the original element from +;; which the source code is coming, it expects from the code calling +;; it to know if lines should be numbered and if code references +;; should appear. +;; +;; Eventually, `org-export-format-code-default' is a higher-level +;; function (it makes use of the two previous functions) which handles +;; line numbering and code references inclusion, and returns source +;; code in a format suitable for plain text or verbatim output. + +(defun org-export-get-loc (element info) + "Return accumulated lines of code up to ELEMENT. + +INFO is the plist used as a communication channel. + +ELEMENT is excluded from count." + (let ((loc 0)) + (org-element-map + (plist-get info :parse-tree) + `(src-block example-block ,(org-element-type element)) + (lambda (el) + (cond + ;; ELEMENT is reached: Quit the loop. + ((eq el element)) + ;; Only count lines from src-block and example-block elements + ;; with a "+n" or "-n" switch. A "-n" switch resets counter. + ((not (memq (org-element-type el) '(src-block example-block))) nil) + ((let ((linums (org-element-property :number-lines el))) + (when linums + ;; Accumulate locs or reset them. + (let ((lines (org-count-lines + (org-trim (org-element-property :value el))))) + (setq loc (if (eq linums 'new) lines (+ loc lines)))))) + ;; Return nil to stay in the loop. + nil))) + info 'first-match) + ;; Return value. + loc)) + +(defun org-export-unravel-code (element) + "Clean source code and extract references out of it. + +ELEMENT has either a `src-block' an `example-block' type. + +Return a cons cell whose CAR is the source code, cleaned from any +reference and protective comma and CDR is an alist between +relative line number (integer) and name of code reference on that +line (string)." + (let* ((line 0) refs + ;; Get code and clean it. Remove blank lines at its + ;; beginning and end. Also remove protective commas. + (code (let ((c (replace-regexp-in-string + "\\`\\([ \t]*\n\\)+" "" + (replace-regexp-in-string + "\\(:?[ \t]*\n\\)*[ \t]*\\'" "\n" + (org-element-property :value element))))) + ;; If appropriate, remove global indentation. + (unless (or org-src-preserve-indentation + (org-element-property :preserve-indent element)) + (setq c (org-remove-indentation c))) + ;; Free up the protected lines. Note: Org blocks + ;; have commas at the beginning or every line. + (if (string= (org-element-property :language element) "org") + (replace-regexp-in-string "^," "" c) + (replace-regexp-in-string + "^\\(,\\)\\(:?\\*\\|[ \t]*#\\+\\)" "" c nil nil 1)))) + ;; Get format used for references. + (label-fmt (regexp-quote + (or (org-element-property :label-fmt element) + org-coderef-label-format))) + ;; Build a regexp matching a loc with a reference. + (with-ref-re + (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$" + (replace-regexp-in-string + "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t)))) + ;; Return value. + (cons + ;; Code with references removed. + (org-element-normalize-string + (mapconcat + (lambda (loc) + (incf line) + (if (not (string-match with-ref-re loc)) loc + ;; Ref line: remove ref, and signal its position in REFS. + (push (cons line (match-string 3 loc)) refs) + (replace-match "" nil nil loc 1))) + (org-split-string code "\n") "\n")) + ;; Reference alist. + refs))) + +(defun org-export-format-code (code fun &optional num-lines ref-alist) + "Format CODE by applying FUN line-wise and return it. + +CODE is a string representing the code to format. FUN is +a function. It must accept three arguments: a line of +code (string), the current line number (integer) or nil and the +reference associated to the current line (string) or nil. + +Optional argument NUM-LINES can be an integer representing the +number of code lines accumulated until the current code. Line +numbers passed to FUN will take it into account. If it is nil, +FUN's second argument will always be nil. This number can be +obtained with `org-export-get-loc' function. + +Optional argument REF-ALIST can be an alist between relative line +number (i.e. ignoring NUM-LINES) and the name of the code +reference on it. If it is nil, FUN's third argument will always +be nil. It can be obtained through the use of +`org-export-unravel-code' function." + (let ((--locs (org-split-string code "\n")) + (--line 0)) + (org-element-normalize-string + (mapconcat + (lambda (--loc) + (incf --line) + (let ((--ref (cdr (assq --line ref-alist)))) + (funcall fun --loc (and num-lines (+ num-lines --line)) --ref))) + --locs "\n")))) + +(defun org-export-format-code-default (element info) + "Return source code from ELEMENT, formatted in a standard way. + +ELEMENT is either a `src-block' or `example-block' element. INFO +is a plist used as a communication channel. + +This function takes care of line numbering and code references +inclusion. Line numbers, when applicable, appear at the +beginning of the line, separated from the code by two white +spaces. Code references, on the other hand, appear flushed to +the right, separated by six white spaces from the widest line of +code." + ;; Extract code and references. + (let* ((code-info (org-export-unravel-code element)) + (code (car code-info)) + (code-lines (org-split-string code "\n")) + (refs (and (org-element-property :retain-labels element) + (cdr code-info))) + ;; Handle line numbering. + (num-start (case (org-element-property :number-lines element) + (continued (org-export-get-loc element info)) + (new 0))) + (num-fmt + (and num-start + (format "%%%ds " + (length (number-to-string + (+ (length code-lines) num-start)))))) + ;; Prepare references display, if required. Any reference + ;; should start six columns after the widest line of code, + ;; wrapped with parenthesis. + (max-width + (+ (apply 'max (mapcar 'length code-lines)) + (if (not num-start) 0 (length (format num-fmt num-start)))))) + (org-export-format-code + code + (lambda (loc line-num ref) + (let ((number-str (and num-fmt (format num-fmt line-num)))) + (concat + number-str + loc + (and ref + (concat (make-string + (- (+ 6 max-width) + (+ (length loc) (length number-str))) ? ) + (format "(%s)" ref)))))) + num-start refs))) + + +;;;; For Tables +;; +;; `org-export-table-has-special-column-p' and and +;; `org-export-table-row-is-special-p' are predicates used to look for +;; meta-information about the table structure. +;; +;; `org-table-has-header-p' tells when the rows before the first rule +;; should be considered as table's header. +;; +;; `org-export-table-cell-width', `org-export-table-cell-alignment' +;; and `org-export-table-cell-borders' extract information from +;; a table-cell element. +;; +;; `org-export-table-dimensions' gives the number on rows and columns +;; in the table, ignoring horizontal rules and special columns. +;; `org-export-table-cell-address', given a table-cell object, returns +;; the absolute address of a cell. On the other hand, +;; `org-export-get-table-cell-at' does the contrary. +;; +;; `org-export-table-cell-starts-colgroup-p', +;; `org-export-table-cell-ends-colgroup-p', +;; `org-export-table-row-starts-rowgroup-p', +;; `org-export-table-row-ends-rowgroup-p', +;; `org-export-table-row-starts-header-p' and +;; `org-export-table-row-ends-header-p' indicate position of current +;; row or cell within the table. + +(defun org-export-table-has-special-column-p (table) + "Non-nil when TABLE has a special column. +All special columns will be ignored during export." + ;; The table has a special column when every first cell of every row + ;; has an empty value or contains a symbol among "/", "#", "!", "$", + ;; "*" "_" and "^". Though, do not consider a first row containing + ;; only empty cells as special. + (let ((special-column-p 'empty)) + (catch 'exit + (mapc + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (let ((value (org-element-contents + (car (org-element-contents row))))) + (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) + (setq special-column-p 'special)) + ((not value)) + (t (throw 'exit nil)))))) + (org-element-contents table)) + (eq special-column-p 'special)))) + +(defun org-export-table-has-header-p (table info) + "Non-nil when TABLE has an header. + +INFO is a plist used as a communication channel. + +A table has an header when it contains at least two row groups." + (let ((rowgroup 1) row-flag) + (org-element-map + table 'table-row + (lambda (row) + (cond + ((> rowgroup 1) t) + ((and row-flag (eq (org-element-property :type row) 'rule)) + (incf rowgroup) (setq row-flag nil)) + ((and (not row-flag) (eq (org-element-property :type row) 'standard)) + (setq row-flag t) nil))) + info))) + +(defun org-export-table-row-is-special-p (table-row info) + "Non-nil if TABLE-ROW is considered special. + +INFO is a plist used as the communication channel. + +All special rows will be ignored during export." + (when (eq (org-element-property :type table-row) 'standard) + (let ((first-cell (org-element-contents + (car (org-element-contents table-row))))) + ;; A row is special either when... + (or + ;; ... it starts with a field only containing "/", + (equal first-cell '("/")) + ;; ... the table contains a special column and the row start + ;; with a marking character among, "^", "_", "$" or "!", + (and (org-export-table-has-special-column-p + (org-export-get-parent table-row)) + (member first-cell '(("^") ("_") ("$") ("!")))) + ;; ... it contains only alignment cookies and empty cells. + (let ((special-row-p 'empty)) + (catch 'exit + (mapc + (lambda (cell) + (let ((value (org-element-contents cell))) + ;; Since VALUE is a secondary string, the following + ;; checks avoid expanding it with `org-export-data'. + (cond ((not value)) + ((and (not (cdr value)) + (stringp (car value)) + (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" + (car value))) + (setq special-row-p 'cookie)) + (t (throw 'exit nil))))) + (org-element-contents table-row)) + (eq special-row-p 'cookie))))))) + +(defun org-export-table-row-group (table-row info) + "Return TABLE-ROW's group. + +INFO is a plist used as the communication channel. + +Return value is the group number, as an integer, or nil special +rows and table rules. Group 1 is also table's header." + (unless (or (eq (org-element-property :type table-row) 'rule) + (org-export-table-row-is-special-p table-row info)) + (let ((group 0) row-flag) + (catch 'found + (mapc + (lambda (row) + (cond + ((and (eq (org-element-property :type row) 'standard) + (not (org-export-table-row-is-special-p row info))) + (unless row-flag (incf group) (setq row-flag t))) + ((eq (org-element-property :type row) 'rule) + (setq row-flag nil))) + (when (eq table-row row) (throw 'found group))) + (org-element-contents (org-export-get-parent table-row))))))) + +(defun org-export-table-cell-width (table-cell info) + "Return TABLE-CELL contents width. + +INFO is a plist used as the communication channel. + +Return value is the width given by the last width cookie in the +same column as TABLE-CELL, or nil." + (let* ((row (org-export-get-parent table-cell)) + (column (let ((cells (org-element-contents row))) + (- (length cells) (length (memq table-cell cells))))) + (table (org-export-get-parent-table table-cell)) + cookie-width) + (mapc + (lambda (row) + (cond + ;; In a special row, try to find a width cookie at COLUMN. + ((org-export-table-row-is-special-p row info) + (let ((value (org-element-contents + (elt (org-element-contents row) column)))) + ;; The following checks avoid expanding unnecessarily the + ;; cell with `org-export-data' + (when (and value + (not (cdr value)) + (stringp (car value)) + (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" (car value)) + (match-string 1 (car value))) + (setq cookie-width + (string-to-number (match-string 1 (car value))))))) + ;; Ignore table rules. + ((eq (org-element-property :type row) 'rule)))) + (org-element-contents table)) + ;; Return value. + cookie-width)) + +(defun org-export-table-cell-alignment (table-cell info) + "Return TABLE-CELL contents alignment. + +INFO is a plist used as the communication channel. + +Return alignment as specified by the last alignment cookie in the +same column as TABLE-CELL. If no such cookie is found, a default +alignment value will be deduced from fraction of numbers in the +column (see `org-table-number-fraction' for more information). +Possible values are `left', `right' and `center'." + (let* ((row (org-export-get-parent table-cell)) + (column (let ((cells (org-element-contents row))) + (- (length cells) (length (memq table-cell cells))))) + (table (org-export-get-parent-table table-cell)) + (number-cells 0) + (total-cells 0) + cookie-align) + (mapc + (lambda (row) + (cond + ;; In a special row, try to find an alignment cookie at + ;; COLUMN. + ((org-export-table-row-is-special-p row info) + (let ((value (org-element-contents + (elt (org-element-contents row) column)))) + ;; Since VALUE is a secondary string, the following checks + ;; avoid useless expansion through `org-export-data'. + (when (and value + (not (cdr value)) + (stringp (car value)) + (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" + (car value)) + (match-string 1 (car value))) + (setq cookie-align (match-string 1 (car value)))))) + ;; Ignore table rules. + ((eq (org-element-property :type row) 'rule)) + ;; In a standard row, check if cell's contents are expressing + ;; some kind of number. Increase NUMBER-CELLS accordingly. + ;; Though, don't bother if an alignment cookie has already + ;; defined cell's alignment. + ((not cookie-align) + (let ((value (org-export-data + (org-element-contents + (elt (org-element-contents row) column)) + info))) + (incf total-cells) + (when (string-match org-table-number-regexp value) + (incf number-cells)))))) + (org-element-contents table)) + ;; Return value. Alignment specified by cookies has precedence + ;; over alignment deduced from cells contents. + (cond ((equal cookie-align "l") 'left) + ((equal cookie-align "r") 'right) + ((equal cookie-align "c") 'center) + ((>= (/ (float number-cells) total-cells) org-table-number-fraction) + 'right) + (t 'left)))) + +(defun org-export-table-cell-borders (table-cell info) + "Return TABLE-CELL borders. + +INFO is a plist used as a communication channel. + +Return value is a list of symbols, or nil. Possible values are: +`top', `bottom', `above', `below', `left' and `right'. Note: +`top' (resp. `bottom') only happen for a cell in the first +row (resp. last row) of the table, ignoring table rules, if any. + +Returned borders ignore special rows." + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent-table table-cell)) + borders) + ;; Top/above border? TABLE-CELL has a border above when a rule + ;; used to demarcate row groups can be found above. Hence, + ;; finding a rule isn't sufficient to push `above' in BORDERS: + ;; another regular row has to be found above that rule. + (let (rule-flag) + (catch 'exit + (mapc (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'above borders)) + (throw 'exit nil))))) + ;; Look at every row before the current one. + (cdr (memq row (reverse (org-element-contents table))))) + ;; No rule above, or rule found starts the table (ignoring any + ;; special row): TABLE-CELL is at the top of the table. + (when rule-flag (push 'above borders)) + (push 'top borders))) + ;; Bottom/below border? TABLE-CELL has a border below when next + ;; non-regular row below is a rule. + (let (rule-flag) + (catch 'exit + (mapc (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'below borders)) + (throw 'exit nil))))) + ;; Look at every row after the current one. + (cdr (memq row (org-element-contents table)))) + ;; No rule below, or rule found ends the table (modulo some + ;; special row): TABLE-CELL is at the bottom of the table. + (when rule-flag (push 'below borders)) + (push 'bottom borders))) + ;; Right/left borders? They can only be specified by column + ;; groups. Column groups are defined in a row starting with "/". + ;; Also a column groups row only contains "<", "<>", ">" or blank + ;; cells. + (catch 'exit + (let ((column (let ((cells (org-element-contents row))) + (- (length cells) (length (memq table-cell cells)))))) + (mapc + (lambda (row) + (unless (eq (org-element-property :type row) 'rule) + (when (equal (org-element-contents + (car (org-element-contents row))) + '("/")) + (let ((column-groups + (mapcar + (lambda (cell) + (let ((value (org-element-contents cell))) + (when (member value '(("<") ("<>") (">") nil)) + (car value)))) + (org-element-contents row)))) + ;; There's a left border when previous cell, if + ;; any, ends a group, or current one starts one. + (when (or (and (not (zerop column)) + (member (elt column-groups (1- column)) + '(">" "<>"))) + (member (elt column-groups column) '("<" "<>"))) + (push 'left borders)) + ;; There's a right border when next cell, if any, + ;; starts a group, or current one ends one. + (when (or (and (/= (1+ column) (length column-groups)) + (member (elt column-groups (1+ column)) + '("<" "<>"))) + (member (elt column-groups column) '(">" "<>"))) + (push 'right borders)) + (throw 'exit nil))))) + ;; Table rows are read in reverse order so last column groups + ;; row has precedence over any previous one. + (reverse (org-element-contents table))))) + ;; Return value. + borders)) + +(defun org-export-table-cell-starts-colgroup-p (table-cell info) + "Non-nil when TABLE-CELL is at the beginning of a row group. +INFO is a plist used as a communication channel." + ;; A cell starts a column group either when it is at the beginning + ;; of a row (or after the special column, if any) or when it has + ;; a left border. + (or (eq (org-element-map + (org-export-get-parent table-cell) + 'table-cell 'identity info 'first-match) + table-cell) + (memq 'left (org-export-table-cell-borders table-cell info)))) + +(defun org-export-table-cell-ends-colgroup-p (table-cell info) + "Non-nil when TABLE-CELL is at the end of a row group. +INFO is a plist used as a communication channel." + ;; A cell ends a column group either when it is at the end of a row + ;; or when it has a right border. + (or (eq (car (last (org-element-contents + (org-export-get-parent table-cell)))) + table-cell) + (memq 'right (org-export-table-cell-borders table-cell info)))) + +(defun org-export-table-row-starts-rowgroup-p (table-row info) + "Non-nil when TABLE-ROW is at the beginning of a column group. +INFO is a plist used as a communication channel." + (unless (or (eq (org-element-property :type table-row) 'rule) + (org-export-table-row-is-special-p table-row info)) + (let ((borders (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (or (memq 'top borders) (memq 'above borders))))) + +(defun org-export-table-row-ends-rowgroup-p (table-row info) + "Non-nil when TABLE-ROW is at the end of a column group. +INFO is a plist used as a communication channel." + (unless (or (eq (org-element-property :type table-row) 'rule) + (org-export-table-row-is-special-p table-row info)) + (let ((borders (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (or (memq 'bottom borders) (memq 'below borders))))) + +(defun org-export-table-row-starts-header-p (table-row info) + "Non-nil when TABLE-ROW is the first table header's row. +INFO is a plist used as a communication channel." + (and (org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + (org-export-table-row-starts-rowgroup-p table-row info) + (= (org-export-table-row-group table-row info) 1))) + +(defun org-export-table-row-ends-header-p (table-row info) + "Non-nil when TABLE-ROW is the last table header's row. +INFO is a plist used as a communication channel." + (and (org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + (org-export-table-row-ends-rowgroup-p table-row info) + (= (org-export-table-row-group table-row info) 1))) + +(defun org-export-table-dimensions (table info) + "Return TABLE dimensions. + +INFO is a plist used as a communication channel. + +Return value is a CONS like (ROWS . COLUMNS) where +ROWS (resp. COLUMNS) is the number of exportable +rows (resp. columns)." + (let (first-row (columns 0) (rows 0)) + ;; Set number of rows, and extract first one. + (org-element-map + table 'table-row + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (incf rows) + (unless first-row (setq first-row row)))) info) + ;; Set number of columns. + (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info) + ;; Return value. + (cons rows columns))) + +(defun org-export-table-cell-address (table-cell info) + "Return address of a regular TABLE-CELL object. + +TABLE-CELL is the cell considered. INFO is a plist used as +a communication channel. + +Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are +zero-based index. Only exportable cells are considered. The +function returns nil for other cells." + (let* ((table-row (org-export-get-parent table-cell)) + (table (org-export-get-parent-table table-cell))) + ;; Ignore cells in special rows or in special column. + (unless (or (org-export-table-row-is-special-p table-row info) + (and (org-export-table-has-special-column-p table) + (eq (car (org-element-contents table-row)) table-cell))) + (cons + ;; Row number. + (let ((row-count 0)) + (org-element-map + table 'table-row + (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) nil) + ((eq row table-row) row-count) + (t (incf row-count) nil))) + info 'first-match)) + ;; Column number. + (let ((col-count 0)) + (org-element-map + table-row 'table-cell + (lambda (cell) + (if (eq cell table-cell) col-count (incf col-count) nil)) + info 'first-match)))))) + +(defun org-export-get-table-cell-at (address table info) + "Return regular table-cell object at ADDRESS in TABLE. + +Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are +zero-based index. TABLE is a table type element. INFO is +a plist used as a communication channel. + +If no table-cell, among exportable cells, is found at ADDRESS, +return nil." + (let ((column-pos (cdr address)) (column-count 0)) + (org-element-map + ;; Row at (car address) or nil. + (let ((row-pos (car address)) (row-count 0)) + (org-element-map + table 'table-row + (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) nil) + ((= row-count row-pos) row) + (t (incf row-count) nil))) + info 'first-match)) + 'table-cell + (lambda (cell) + (if (= column-count column-pos) cell + (incf column-count) nil)) + info 'first-match))) + + +;;;; For Tables Of Contents +;; +;; `org-export-collect-headlines' builds a list of all exportable +;; headline elements, maybe limited to a certain depth. One can then +;; easily parse it and transcode it. +;; +;; Building lists of tables, figures or listings is quite similar. +;; Once the generic function `org-export-collect-elements' is defined, +;; `org-export-collect-tables', `org-export-collect-figures' and +;; `org-export-collect-listings' can be derived from it. + +(defun org-export-collect-headlines (info &optional n) + "Collect headlines in order to build a table of contents. + +INFO is a plist used as a communication channel. + +When optional argument N is an integer, it specifies the depth of +the table of contents. Otherwise, it is set to the value of the +last headline level. See `org-export-headline-levels' for more +information. + +Return a list of all exportable headlines as parsed elements." + (unless (wholenump n) (setq n (plist-get info :headline-levels))) + (org-element-map + (plist-get info :parse-tree) + 'headline + (lambda (headline) + ;; Strip contents from HEADLINE. + (let ((relative-level (org-export-get-relative-level headline info))) + (unless (> relative-level n) headline))) + info)) + +(defun org-export-collect-elements (type info &optional predicate) + "Collect referenceable elements of a determined type. + +TYPE can be a symbol or a list of symbols specifying element +types to search. Only elements with a caption are collected. + +INFO is a plist used as a communication channel. + +When non-nil, optional argument PREDICATE is a function accepting +one argument, an element of type TYPE. It returns a non-nil +value when that element should be collected. + +Return a list of all elements found, in order of appearance." + (org-element-map + (plist-get info :parse-tree) type + (lambda (element) + (and (org-element-property :caption element) + (or (not predicate) (funcall predicate element)) + element)) + info)) + +(defun org-export-collect-tables (info) + "Build a list of tables. +INFO is a plist used as a communication channel. + +Return a list of table elements with a caption." + (org-export-collect-elements 'table info)) + +(defun org-export-collect-figures (info predicate) + "Build a list of figures. + +INFO is a plist used as a communication channel. PREDICATE is +a function which accepts one argument: a paragraph element and +whose return value is non-nil when that element should be +collected. + +A figure is a paragraph type element, with a caption, verifying +PREDICATE. The latter has to be provided since a \"figure\" is +a vague concept that may depend on back-end. + +Return a list of elements recognized as figures." + (org-export-collect-elements 'paragraph info predicate)) + +(defun org-export-collect-listings (info) + "Build a list of src blocks. + +INFO is a plist used as a communication channel. + +Return a list of src-block elements with a caption." + (org-export-collect-elements 'src-block info)) + + +;;;; Topology +;; +;; Here are various functions to retrieve information about the +;; neighbourhood of a given element or object. Neighbours of interest +;; are direct parent (`org-export-get-parent'), parent headline +;; (`org-export-get-parent-headline'), first element containing an +;; object, (`org-export-get-parent-element'), parent table +;; (`org-export-get-parent-table'), previous element or object +;; (`org-export-get-previous-element') and next element or object +;; (`org-export-get-next-element'). +;; +;; `org-export-get-genealogy' returns the full genealogy of a given +;; element or object, from closest parent to full parse tree. + +(defun org-export-get-parent (blob) + "Return BLOB parent or nil. +BLOB is the element or object considered." + (org-element-property :parent blob)) + +(defun org-export-get-genealogy (blob) + "Return full genealogy relative to a given element or object. + +BLOB is the element or object being considered. + +Ancestors are returned from closest to farthest, the last one +being the full parse tree." + (let (genealogy (parent blob)) + (while (setq parent (org-element-property :parent parent)) + (push parent genealogy)) + (nreverse genealogy))) + +(defun org-export-get-parent-headline (blob) + "Return BLOB parent headline or nil. +BLOB is the element or object being considered." + (let ((parent blob)) + (while (and (setq parent (org-element-property :parent parent)) + (not (eq (org-element-type parent) 'headline)))) + parent)) + +(defun org-export-get-parent-element (object) + "Return first element containing OBJECT or nil. +OBJECT is the object to consider." + (let ((parent object)) + (while (and (setq parent (org-element-property :parent parent)) + (memq (org-element-type parent) org-element-all-objects))) + parent)) + +(defun org-export-get-parent-table (object) + "Return OBJECT parent table or nil. +OBJECT is either a `table-cell' or `table-element' type object." + (let ((parent object)) + (while (and (setq parent (org-element-property :parent parent)) + (not (eq (org-element-type parent) 'table)))) + parent)) + +(defun org-export-get-previous-element (blob info) + "Return previous element or object. +BLOB is an element or object. INFO is a plist used as +a communication channel. Return previous exportable element or +object, a string, or nil." + (let (prev) + (catch 'exit + (mapc (lambda (obj) + (cond ((eq obj blob) (throw 'exit prev)) + ((memq obj (plist-get info :ignore-list))) + (t (setq prev obj)))) + (org-element-contents (org-export-get-parent blob)))))) + +(defun org-export-get-next-element (blob info) + "Return next element or object. +BLOB is an element or object. INFO is a plist used as +a communication channel. Return next exportable element or +object, a string, or nil." + (catch 'found + (mapc (lambda (obj) + (unless (memq obj (plist-get info :ignore-list)) + (throw 'found obj))) + (cdr (memq blob (org-element-contents (org-export-get-parent blob))))) + nil)) + + +;;;; Translation +;; +;; `org-export-translate' translates a string according to language +;; specified by LANGUAGE keyword or `org-export-language-setup' +;; variable and a specified charset. `org-export-dictionary' contains +;; the dictionary used for the translation. + +(defconst org-export-dictionary + '(("Author" + ("fr" + :ascii "Auteur" + :latin1 "Auteur" + :utf-8 "Auteur")) + ("Date" + ("fr" + :ascii "Date" + :latin1 "Date" + :utf-8 "Date")) + ("Equation") + ("Figure") + ("Footnotes" + ("fr" + :ascii "Notes de bas de page" + :latin1 "Notes de bas de page" + :utf-8 "Notes de bas de page")) + ("List of Listings" + ("fr" + :ascii "Liste des programmes" + :latin1 "Liste des programmes" + :utf-8 "Liste des programmes")) + ("List of Tables" + ("fr" + :ascii "Liste des tableaux" + :latin1 "Liste des tableaux" + :utf-8 "Liste des tableaux")) + ("Listing %d:" + ("fr" + :ascii "Programme %d :" + :latin1 "Programme %d :" + :utf-8 "Programme nº %d :")) + ("Listing %d: %s" + ("fr" + :ascii "Programme %d : %s" + :latin1 "Programme %d : %s" + :utf-8 "Programme nº %d : %s")) + ("See section %s" + ("fr" + :ascii "cf. section %s" + :latin1 "cf. section %s" + :utf-8 "cf. section %s")) + ("Table %d:" + ("fr" + :ascii "Tableau %d :" + :latin1 "Tableau %d :" + :utf-8 "Tableau nº %d :")) + ("Table %d: %s" + ("fr" + :ascii "Tableau %d : %s" + :latin1 "Tableau %d : %s" + :utf-8 "Tableau nº %d : %s")) + ("Table of Contents" + ("fr" + :ascii "Sommaire" + :latin1 "Table des matières" + :utf-8 "Table des matières")) + ("Unknown reference" + ("fr" + :ascii "Destination inconnue" + :latin1 "Référence inconnue" + :utf-8 "Référence inconnue"))) + "Dictionary for export engine. + +Alist whose CAR is the string to translate and CDR is an alist +whose CAR is the language string and CDR is a plist whose +properties are possible charsets and values translated terms. + +It is used as a database for `org-export-translate'. Since this +function returns the string as-is if no translation was found, +the variable only needs to record values different from the +entry.") + +(defun org-export-translate (s encoding info) + "Translate string S according to language specification. + +ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1' +and `:utf-8'. INFO is a plist used as a communication channel. + +Translation depends on `:language' property. Return the +translated string. If no translation is found return S." + (let ((lang (plist-get info :language)) + (translations (cdr (assoc s org-export-dictionary)))) + (or (plist-get (cdr (assoc lang translations)) encoding) s))) + + + +;;; The Dispatcher +;; +;; `org-export-dispatch' is the standard interactive way to start an +;; export process. It uses `org-export-dispatch-ui' as a subroutine +;; for its interface. Most commons back-ends should have an entry in +;; it. + +;;;###autoload +(defun org-export-dispatch () + "Export dispatcher for Org mode. + +It provides an access to common export related tasks in a buffer. +Its interface comes in two flavours: standard and expert. While +both share the same set of bindings, only the former displays the +valid keys associations. Set `org-export-dispatch-use-expert-ui' +to switch to one or the other. + +Return an error if key pressed has no associated command." + (interactive) + (let* ((input (org-export-dispatch-ui + (if (listp org-export-initial-scope) org-export-initial-scope + (list org-export-initial-scope)) + org-export-dispatch-use-expert-ui)) + (raw-key (car input)) + (optns (cdr input))) + ;; Translate "C-a", "C-b"... into "a", "b"... Then take action + ;; depending on user's key pressed. + (case (if (< raw-key 27) (+ raw-key 96) raw-key) + ;; Allow to quit with "q" key. + (?q nil) + ;; Export with `e-ascii' back-end. + ((?A ?N ?U) + (org-e-ascii-export-as-ascii + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns) + `(:ascii-charset ,(case raw-key (?A 'ascii) (?N 'latin1) (t 'utf-8))))) + ((?a ?n ?u) + (org-e-ascii-export-to-ascii + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns) + `(:ascii-charset ,(case raw-key (?a 'ascii) (?n 'latin1) (t 'utf-8))))) + ;; Export with `e-latex' back-end. + (?L (org-e-latex-export-as-latex + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?l + (org-e-latex-export-to-latex + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?p + (org-e-latex-export-to-pdf + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?d + (org-open-file + (org-e-latex-export-to-pdf + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) + ;; Export with `e-html' back-end. + (?H + (org-e-html-export-as-html + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?h + (org-e-html-export-to-html + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?b + (org-open-file + (org-e-html-export-to-html + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) + ;; Export with `e-odt' back-end. + (?o + (org-e-odt-export-to-odt + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) + (?O + (org-open-file + (org-e-odt-export-to-odt + (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) + ;; Publishing facilities + (?F + (org-e-publish-current-file (memq 'force optns))) + (?P + (org-e-publish-current-project (memq 'force optns))) + (?X + (let ((project + (assoc (org-icompleting-read + "Publish project: " org-e-publish-project-alist nil t) + org-e-publish-project-alist))) + (org-e-publish project (memq 'force optns)))) + (?E + (org-e-publish-all (memq 'force optns))) + ;; Undefined command. + (t (error "No command associated with key %s" + (char-to-string raw-key)))))) + +(defun org-export-dispatch-ui (options expertp) + "Handle interface for `org-export-dispatch'. + +OPTIONS is a list containing current interactive options set for +export. It can contain any of the following symbols: +`body' toggles a body-only export +`subtree' restricts export to current subtree +`visible' restricts export to visible part of buffer. +`force' force publishing files. + +EXPERTP, when non-nil, triggers expert UI. In that case, no help +buffer is provided, but indications about currently active +options are given in the prompt. Moreover, \[?] allows to switch +back to standard interface. + +Return value is a list with key pressed as CAR and a list of +final interactive export options as CDR." + (let ((help + (format "---- (Options) ------------------------------------------- + +\[1] Body only: %s [2] Export scope: %s +\[3] Visible only: %s [4] Force publishing: %s + + +--- (ASCII/Latin-1/UTF-8 Export) ------------------------- + +\[a/n/u] to TXT file [A/N/U] to temporary buffer + +--- (HTML Export) ---------------------------------------- + +\[h] to HTML file [b] ... and open it +\[H] to temporary buffer + +--- (LaTeX Export) --------------------------------------- + +\[l] to TEX file [L] to temporary buffer +\[p] to PDF file [d] ... and open it + +--- (ODF Export) ----------------------------------------- + +\[o] to ODT file [O] ... and open it + +--- (Publish) -------------------------------------------- + +\[F] current file [P] current project +\[X] a project [E] every project" + (if (memq 'body options) "On " "Off") + (if (memq 'subtree options) "Subtree" "Buffer ") + (if (memq 'visible options) "On " "Off") + (if (memq 'force options) "On " "Off"))) + (standard-prompt "Export command: ") + (expert-prompt (format "Export command (%s%s%s%s): " + (if (memq 'body options) "b" "-") + (if (memq 'subtree options) "s" "-") + (if (memq 'visible options) "v" "-") + (if (memq 'force options) "f" "-"))) + (handle-keypress + (function + ;; Read a character from command input, toggling interactive + ;; options when applicable. PROMPT is the displayed prompt, + ;; as a string. + (lambda (prompt) + (let ((key (read-char-exclusive prompt))) + (cond + ;; Ignore non-standard characters (i.e. "M-a"). + ((not (characterp key)) (org-export-dispatch-ui options expertp)) + ;; Help key: Switch back to standard interface if + ;; expert UI was active. + ((eq key ??) (org-export-dispatch-ui options nil)) + ;; Toggle export options. + ((memq key '(?1 ?2 ?3 ?4)) + (org-export-dispatch-ui + (let ((option (case key (?1 'body) (?2 'subtree) (?3 'visible) + (?4 'force)))) + (if (memq option options) (remq option options) + (cons option options))) + expertp)) + ;; Action selected: Send key and options back to + ;; `org-export-dispatch'. + (t (cons key options)))))))) + ;; With expert UI, just read key with a fancy prompt. In standard + ;; UI, display an intrusive help buffer. + (if expertp (funcall handle-keypress expert-prompt) + (save-window-excursion + (delete-other-windows) + (with-output-to-temp-buffer "*Org Export/Publishing Help*" (princ help)) + (org-fit-window-to-buffer + (get-buffer-window "*Org Export/Publishing Help*")) + (funcall handle-keypress standard-prompt))))) + + +(provide 'org-export) +;;; org-export.el ends here |