diff options
Diffstat (limited to 'elpa/org-9.5.2/ox.el')
| -rw-r--r-- | elpa/org-9.5.2/ox.el | 7029 |
1 files changed, 7029 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/ox.el b/elpa/org-9.5.2/ox.el new file mode 100644 index 0000000..80202b0 --- /dev/null +++ b/elpa/org-9.5.2/ox.el @@ -0,0 +1,7029 @@ +;;; ox.el --- Export Framework for Org Mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2012-2021 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> +;; Maintainer: Nicolas Goaziou <n.goaziou at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://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 of 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 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 functions is `org-export-as'. It returns the transcoded +;; buffer as a string. Its derivatives are `org-export-to-buffer' and +;; `org-export-to-file'. +;; +;; An export back-end is defined with `org-export-define-backend'. +;; This function can also support specific buffer keywords, OPTION +;; keyword's items and filters. Refer to function's documentation for +;; more information. +;; +;; If the new back-end shares most properties with another one, +;; `org-export-define-derived-backend' can be used to simplify the +;; process. +;; +;; Any back-end can define its own variables. Among them, those +;; customizable should belong to the `org-export-BACKEND' group. +;; +;; Tools for common tasks across back-ends are implemented in the +;; following part of the file. +;; +;; Eventually, a dispatcher (`org-export-dispatch') is provided in the +;; last one. +;; +;; See <https://orgmode.org/worg/dev/org-export-reference.html> for +;; more information. + +;;; Code: + +(require 'cl-lib) +(require 'ob-exp) +(require 'oc) +(require 'oc-basic) ;default value for `org-cite-export-processors' +(require 'ol) +(require 'org-element) +(require 'org-macro) +(require 'tabulated-list) + +(declare-function org-src-coderef-format "org-src" (&optional element)) +(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) +(declare-function org-publish "ox-publish" (project &optional force async)) +(declare-function org-publish-all "ox-publish" (&optional force async)) +(declare-function org-publish-current-file "ox-publish" (&optional force async)) +(declare-function org-publish-current-project "ox-publish" (&optional force async)) + +(defvar org-publish-project-alist) +(defvar org-table-number-fraction) +(defvar org-table-number-regexp) + + +;;; Internal Variables +;; +;; Among internal variables, the most important is +;; `org-export-options-alist'. This variable define the global export +;; options, shared between every exporter, and how they are acquired. + +(defconst org-export-max-depth 19 + "Maximum nesting depth for headlines, counting from 0.") + +(defconst org-export-options-alist + '((:title "TITLE" nil nil parse) + (:date "DATE" nil nil parse) + (:author "AUTHOR" nil user-full-name parse) + (:email "EMAIL" nil user-mail-address t) + (:language "LANGUAGE" nil org-export-default-language t) + (:select-tags "SELECT_TAGS" nil org-export-select-tags split) + (:exclude-tags "EXCLUDE_TAGS" nil org-export-exclude-tags split) + (:creator "CREATOR" nil org-export-creator-string) + (:headline-levels nil "H" org-export-headline-levels) + (:preserve-breaks nil "\\n" org-export-preserve-breaks) + (:section-numbers nil "num" org-export-with-section-numbers) + (:time-stamp-file nil "timestamp" org-export-time-stamp-file) + (:with-archived-trees nil "arch" org-export-with-archived-trees) + (:with-author nil "author" org-export-with-author) + (:with-broken-links nil "broken-links" org-export-with-broken-links) + (:with-clocks nil "c" org-export-with-clocks) + (:with-creator nil "creator" org-export-with-creator) + (:with-date nil "date" org-export-with-date) + (:with-drawers nil "d" org-export-with-drawers) + (:with-email nil "email" org-export-with-email) + (:with-emphasize nil "*" org-export-with-emphasize) + (:with-entities nil "e" org-export-with-entities) + (:with-fixed-width nil ":" org-export-with-fixed-width) + (:with-footnotes nil "f" org-export-with-footnotes) + (:with-inlinetasks nil "inline" org-export-with-inlinetasks) + (:with-latex nil "tex" org-export-with-latex) + (:with-planning nil "p" org-export-with-planning) + (:with-priority nil "pri" org-export-with-priority) + (:with-properties nil "prop" org-export-with-properties) + (:with-smart-quotes nil "'" org-export-with-smart-quotes) + (:with-special-strings nil "-" org-export-with-special-strings) + (:with-statistics-cookies nil "stat" org-export-with-statistics-cookies) + (:with-sub-superscript nil "^" org-export-with-sub-superscripts) + (:with-toc nil "toc" org-export-with-toc) + (:with-tables nil "|" org-export-with-tables) + (:with-tags nil "tags" org-export-with-tags) + (:with-tasks nil "tasks" org-export-with-tasks) + (:with-timestamps nil "<" org-export-with-timestamps) + (:with-title nil "title" org-export-with-title) + (:with-todo-keywords nil "todo" org-export-with-todo-keywords) + ;; Citations processing. + (:cite-export "CITE_EXPORT" nil org-cite-export-processors)) + "Alist between export properties and ways to set them. + +The key of the alist is the property name, and the value is a list +like (KEYWORD OPTION DEFAULT BEHAVIOR) where: + +KEYWORD is a string representing a buffer keyword, or nil. Each + property defined this way can also be set, during subtree + export, through a headline property named after the keyword + with the \"EXPORT_\" prefix (i.e. DATE keyword and EXPORT_DATE + property). +OPTION is a string that could be found in an #+OPTIONS: line. +DEFAULT is the default value for the property. +BEHAVIOR determines how Org should handle multiple keywords for + the same property. It is a symbol among: + nil Keep old value and discard the new one. + t Replace old value with the new one. + `space' Concatenate the values, separating them with a space. + `newline' Concatenate the values, separating them with + a newline. + `split' Split values at white spaces, and cons them to the + previous list. + `parse' Parse value as a list of strings and Org objects, + which can then be transcoded with, e.g., + `org-export-data'. It implies `space' behavior. + +Values set through KEYWORD and OPTION have precedence over +DEFAULT. + +All these properties should be back-end agnostic. Back-end +specific properties are set through `org-export-define-backend'. +Properties redefined there have precedence over these.") + +(defconst org-export-filters-alist + '((:filter-body . org-export-filter-body-functions) + (: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-diary-sexp . org-export-filter-diary-sexp-functions) + (:filter-drawer . org-export-filter-drawer-functions) + (:filter-dynamic-block . org-export-filter-dynamic-block-functions) + (:filter-entity . org-export-filter-entity-functions) + (:filter-example-block . org-export-filter-example-block-functions) + (:filter-export-block . org-export-filter-export-block-functions) + (:filter-export-snippet . org-export-filter-export-snippet-functions) + (:filter-final-output . org-export-filter-final-output-functions) + (:filter-fixed-width . org-export-filter-fixed-width-functions) + (:filter-footnote-definition . org-export-filter-footnote-definition-functions) + (:filter-footnote-reference . org-export-filter-footnote-reference-functions) + (:filter-headline . org-export-filter-headline-functions) + (:filter-horizontal-rule . org-export-filter-horizontal-rule-functions) + (:filter-inline-babel-call . org-export-filter-inline-babel-call-functions) + (:filter-inline-src-block . org-export-filter-inline-src-block-functions) + (:filter-inlinetask . org-export-filter-inlinetask-functions) + (:filter-italic . org-export-filter-italic-functions) + (:filter-item . org-export-filter-item-functions) + (:filter-keyword . org-export-filter-keyword-functions) + (:filter-latex-environment . org-export-filter-latex-environment-functions) + (:filter-latex-fragment . org-export-filter-latex-fragment-functions) + (:filter-line-break . org-export-filter-line-break-functions) + (:filter-link . org-export-filter-link-functions) + (:filter-node-property . org-export-filter-node-property-functions) + (:filter-options . org-export-filter-options-functions) + (:filter-paragraph . org-export-filter-paragraph-functions) + (:filter-parse-tree . org-export-filter-parse-tree-functions) + (:filter-plain-list . org-export-filter-plain-list-functions) + (:filter-plain-text . org-export-filter-plain-text-functions) + (:filter-planning . org-export-filter-planning-functions) + (:filter-property-drawer . org-export-filter-property-drawer-functions) + (:filter-quote-block . org-export-filter-quote-block-functions) + (:filter-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.") + +(defconst org-export-ignored-local-variables + '(org-font-lock-keywords + org-element--cache org-element--cache-objects org-element--cache-sync-keys + org-element--cache-sync-requests org-element--cache-sync-timer) + "List of variables not copied through upon buffer duplication. +Export process takes place on a copy of the original buffer. +When this copy is created, all Org related local variables not in +this list are copied to the new buffer. Variables with an +unreadable value are also ignored.") + +(defvar org-export-async-debug nil + "Non-nil means asynchronous export process should leave data behind. + +This data is found in the appropriate \"*Org Export Process*\" +buffer, and in files prefixed with \"org-export-process\" and +located in `temporary-file-directory'. + +When non-nil, it will also set `debug-on-error' to a non-nil +value in the external process.") + +(defvar org-export-stack-contents nil + "Record asynchronously generated export results and processes. +This is an alist: its CAR is the source of the +result (destination file or buffer for a finished process, +original buffer for a running one) and its CDR is a list +containing the back-end used, as a symbol, and either a process +or the time at which it finished. It is used to build the menu +from `org-export-stack'.") + +(defvar org-export-registered-backends nil + "List of backends currently available in the exporter. +This variable is set with `org-export-define-backend' and +`org-export-define-derived-backend' functions.") + +(defvar org-export-dispatch-last-action nil + "Last command called from the dispatcher. +The value should be a list. Its CAR is the action, as a symbol, +and its CDR is a list of export options.") + +(defvar org-export-dispatch-last-position (make-marker) + "The position where the last export command was created using the dispatcher. +This marker will be used with `\\[universal-argument] C-c C-e' to make sure export repetition +uses the same subtree if the previous command was restricted to a subtree.") + +;; For compatibility with Org < 8 +(defvar org-export-current-backend nil + "Name, if any, of the back-end used during an export process. + +Its value is a symbol such as `html', `latex', `ascii', or nil if +the back-end is anonymous (see `org-export-create-backend') or if +there is no export process in progress. + +It can be used to teach Babel blocks how to act differently +according to the back-end used.") + + + +;;; User-configurable Variables +;; +;; Configuration for the masses. +;; +;; They should never be accessed directly, as their value is to be +;; stored in a property list (cf. `org-export-options-alist'). +;; Back-ends will read their value from there instead. + +(defgroup org-export nil + "Options for exporting Org mode files." + :tag "Org Export" + :group 'org) + +(defgroup org-export-general nil + "General options for export engine." + :tag "Org Export General" + :group 'org-export) + +(defcustom org-export-with-archived-trees 'headline + "Whether sub-trees with the ARCHIVE tag should be exported. + +This can have three different values: +nil Do not export, pretend this tree is not present. +t Do export the entire tree. +`headline' Only export the headline, but skip the tree below it. + +This option can also be set with the OPTIONS keyword, +e.g. \"arch:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "Not at all" nil) + (const :tag "Headline only" headline) + (const :tag "Entirely" t)) + :safe (lambda (x) (memq x '(t nil headline)))) + +(defcustom org-export-with-author t + "Non-nil means insert author name into the exported file. +This option can also be set with the OPTIONS keyword, +e.g. \"author:nil\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-clocks nil + "Non-nil means export CLOCK keywords. +This option can also be set with the OPTIONS keyword, +e.g. \"c:t\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-creator nil + "Non-nil means the postamble should contain a creator sentence. + +The sentence can be set in `org-export-creator-string', which +see. + +This option can also be set with the OPTIONS keyword, e.g., +\"creator:t\"." + :group 'org-export-general + :version "26.1" + :package-version '(Org . "8.3") + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-date t + "Non-nil means insert date in the exported document. +This option can also be set with the OPTIONS keyword, +e.g. \"date:nil\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-date-timestamp-format nil + "Time-stamp format string to use for DATE keyword. + +The format string, when specified, only applies if date consists +in a single time-stamp. Otherwise its value will be ignored. + +See `format-time-string' for details on how to build this +string." + :group 'org-export-general + :type '(choice + (string :tag "Time-stamp format string") + (const :tag "No format string" nil)) + :safe (lambda (x) (or (null x) (stringp x)))) + +(defcustom org-export-creator-string + (format "Emacs %s (Org mode %s)" + emacs-version + (if (fboundp 'org-version) (org-version) "unknown version")) + "Information about the creator of the document. +This option can also be set on with the CREATOR keyword." + :group 'org-export-general + :type '(string :tag "Creator string") + :safe #'stringp) + +(defcustom org-export-with-drawers '(not "LOGBOOK") + "Non-nil means export contents of standard drawers. + +When t, all drawers are exported. This may also be a list of +drawer names to export, as strings. If that list starts with +`not', only drawers with such names will be ignored. + +This variable doesn't apply to properties drawers. See +`org-export-with-properties' instead. + +This option can also be set with the OPTIONS keyword, +e.g. \"d:nil\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "All drawers" t) + (const :tag "None" nil) + (repeat :tag "Selected drawers" + (string :tag "Drawer name")) + (list :tag "Ignored drawers" + (const :format "" not) + (repeat :tag "Specify names of drawers to ignore during export" + :inline t + (string :tag "Drawer name")))) + :safe (lambda (x) (or (booleanp x) (consp x)))) + +(defcustom org-export-with-email nil + "Non-nil means insert author email into the exported file. +This option can also be set with the OPTIONS keyword, +e.g. \"email:t\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-emphasize t + "Non-nil means interpret *word*, /word/, _word_ and +word+. + +If the export target supports emphasizing text, the word will be +typeset in bold, italic, with an underline or strike-through, +respectively. + +This option can also be set with the OPTIONS keyword, +e.g. \"*:nil\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(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")) + :safe (lambda (x) (and (listp x) (cl-every #'stringp x)))) + +(defcustom org-export-with-fixed-width t + "Non-nil means export lines starting with \":\". +This option can also be set with the OPTIONS keyword, +e.g. \"::nil\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-footnotes t + "Non-nil means Org footnotes should be exported. +This option can also be set with the OPTIONS keyword, +e.g. \"f:nil\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-latex t + "Non-nil means process LaTeX environments and fragments. + +This option can also be set with the OPTIONS line, +e.g. \"tex:verbatim\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim. +t Allow export of math snippets." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Interpret math snippets" t) + (const :tag "Leave math verbatim" verbatim)) + :safe (lambda (x) (memq x '(t nil verbatim)))) + +(defcustom org-export-headline-levels 3 + "The last level which is still exported as a headline. + +Inferior levels will usually produce itemize or enumerate lists +when exported, but back-end behavior may differ. + +This option can also be set with the OPTIONS keyword, +e.g. \"H:2\"." + :group 'org-export-general + :type 'integer + :safe #'integerp) + +(defcustom org-export-default-language "en" + "The default language for export and clocktable translations, as a string. +This may have an association in +`org-clock-clocktable-language-setup', +`org-export-smart-quotes-alist' and `org-export-dictionary'. +This option can also be set with the LANGUAGE keyword." + :group 'org-export-general + :type '(string :tag "Language") + :safe #'stringp) + +(defcustom org-export-preserve-breaks nil + "Non-nil means preserve all line breaks when exporting. +This option can also be set with the OPTIONS keyword, +e.g. \"\\n:t\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(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 keyword, +e.g. \"e:nil\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-inlinetasks t + "Non-nil means inlinetasks should be exported. +This option can also be set with the OPTIONS keyword, +e.g. \"inline:nil\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-planning nil + "Non-nil means include planning info in export. + +Planning info is the line containing either SCHEDULED:, +DEADLINE:, CLOSED: time-stamps, or a combination of them. + +This option can also be set with the OPTIONS keyword, +e.g. \"p:t\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-priority nil + "Non-nil means include priority cookies in export. +This option can also be set with the OPTIONS keyword, +e.g. \"pri:t\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-properties nil + "Non-nil means export contents of properties drawers. + +When t, all properties are exported. This may also be a list of +properties to export, as strings. + +This option can also be set with the OPTIONS keyword, +e.g. \"prop:t\"." + :group 'org-export-general + :version "26.1" + :package-version '(Org . "8.3") + :type '(choice + (const :tag "All properties" t) + (const :tag "None" nil) + (repeat :tag "Selected properties" + (string :tag "Property name"))) + :safe (lambda (x) (or (booleanp x) + (and (listp x) (cl-every #'stringp x))))) + +(defcustom org-export-with-section-numbers t + "Non-nil means add section numbers to headlines when exporting. + +When set to an integer n, numbering will only happen for +headlines whose relative level is higher or equal to n. + +This option can also be set with the OPTIONS keyword, +e.g. \"num:t\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(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")) + :safe (lambda (x) (and (listp x) (cl-every #'stringp x)))) + +(defcustom org-export-with-smart-quotes nil + "Non-nil means activate smart quotes during export. +This option can also be set with the OPTIONS keyword, +e.g., \"':t\". + +When setting this to non-nil, you need to take care of +using the correct Babel package when exporting to LaTeX. +E.g., you can load Babel for french like this: + +#+LATEX_HEADER: \\usepackage[french]{babel}" + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-special-strings t + "Non-nil means interpret \"\\-\", \"--\" and \"---\" for export. + +When this option is turned on, these strings will be exported as: + + Org HTML LaTeX UTF-8 + -----+----------+--------+------- + \\- ­ \\- + -- – -- – + --- — --- — + ... … \\ldots … + +This option can also be set with the OPTIONS keyword, +e.g. \"-:nil\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-statistics-cookies t + "Non-nil means include statistics cookies in export. +This option can also be set with the OPTIONS keyword, +e.g. \"stat:nil\"" + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-sub-superscripts t + "Non-nil means interpret \"_\" and \"^\" for export. + +If you want to control how Org displays those characters, see +`org-use-sub-superscripts'. `org-export-with-sub-superscripts' +used to be an alias for `org-use-sub-superscripts' in Org <8.0, +it is not anymore. + +When this option is turned on, you can use TeX-like syntax for +sub- and superscripts and see them exported correctly. + +You can also set the option with #+OPTIONS: ^:t + +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." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Interpret them" t) + (const :tag "Curly brackets only" {}) + (const :tag "Do not interpret them" nil)) + :safe (lambda (x) (memq x '(t nil {})))) + +(defcustom org-export-with-toc t + "Non-nil means create a table of contents in exported files. + +The table of contents contains headlines with levels up to +`org-export-headline-levels'. + +When this variable is set to an integer N, include levels up to +N in the table of contents. Although it may then be different +from `org-export-headline-levels', it is cannot be larger than +the number of headline levels. + +When nil, no table of contents is created. + +This option can also be set with the OPTIONS keyword, +e.g. \"toc:nil\" or \"toc:3\"." + :group 'org-export-general + :type '(choice + (const :tag "No Table of Contents" nil) + (const :tag "Full Table of Contents" t) + (integer :tag "TOC to level")) + :safe (lambda (x) + (or (booleanp x) + (integerp x)))) + +(defcustom org-export-with-tables t + "Non-nil means export tables. +This option can also be set with the OPTIONS keyword, +e.g. \"|:nil\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-tags t + "If nil, do not export tags, just remove them from headlines. + +If this is the symbol `not-in-toc', tags will be removed from +table of contents entries, but still be shown in the headlines of +the document. + +This option can also be set with the OPTIONS keyword, +e.g. \"tags:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "Off" nil) + (const :tag "Not in TOC" not-in-toc) + (const :tag "On" t)) + :safe (lambda (x) (memq x '(t nil not-in-toc)))) + +(defcustom org-export-with-tasks t + "Non-nil means include TODO items for export. + +This may have the following values: +t include tasks independent of state. +`todo' include only tasks that are not yet done. +`done' include only tasks that are already done. +nil ignore all tasks. +list of keywords include tasks with these keywords. + +This option can also be set with the OPTIONS keyword, +e.g. \"tasks:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "All tasks" t) + (const :tag "No tasks" nil) + (const :tag "Not-done tasks" todo) + (const :tag "Only done tasks" done) + (repeat :tag "Specific TODO keywords" + (string :tag "Keyword"))) + :safe (lambda (x) (or (memq x '(nil t todo done)) + (and (listp x) + (cl-every #'stringp x))))) + +(defcustom org-export-with-title t + "Non-nil means print title into the exported file. +This option can also be set with the OPTIONS keyword, +e.g. \"title:nil\"." + :group 'org-export-general + :version "26.1" + :package-version '(Org . "8.3") + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-time-stamp-file t + "Non-nil means insert a time stamp into the exported file. +The time stamp shows when the file was created. This option can +also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"." + :group 'org-export-general + :type 'boolean + :safe #'booleanp) + +(defcustom org-export-with-timestamps t + "Non-nil means allow timestamps in export. + +It can be set to any of the following values: + t export all timestamps. + `active' export active timestamps only. + `inactive' export inactive timestamps only. + nil do not export timestamps + +This only applies to timestamps isolated in a paragraph +containing only timestamps. Other timestamps are always +exported. + +This option can also be set with the OPTIONS keyword, e.g. +\"<:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "All timestamps" t) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "No timestamp" nil)) + :safe (lambda (x) (memq x '(t nil active inactive)))) + +(defcustom org-export-with-todo-keywords t + "Non-nil means include TODO keywords in export. +When nil, remove all these keywords from the export. This option +can also be set with the OPTIONS keyword, e.g. \"todo:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-allow-bind-keywords nil + "Non-nil means BIND keywords can define local variable values. +This is a potential security risk, which is why the default value +is nil. You can also allow them through local buffer variables." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-with-broken-links nil + "Non-nil means do not raise an error on broken links. + +When this variable is non-nil, broken links are ignored, without +stopping the export process. If it is set to `mark', broken +links are marked as such in the output, with a string like + + [BROKEN LINK: path] + +where PATH is the un-resolvable reference. + +This option can also be set with the OPTIONS keyword, e.g., +\"broken-links:mark\"." + :group 'org-export-general + :version "26.1" + :package-version '(Org . "9.0") + :type '(choice + (const :tag "Ignore broken links" t) + (const :tag "Mark broken links in output" mark) + (const :tag "Raise an error" nil))) + +(defcustom org-export-snippet-translation-alist nil + "Alist between export snippets back-ends and exporter back-ends. + +This variable allows providing shortcuts for export snippets. + +For example, with a value of \\='((\"h\" . \"html\")), the +HTML back-end will recognize the contents of \"@@h:<b>@@\" as +HTML code while every other back-end will ignore it." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (cons (string :tag "Shortcut") + (string :tag "Back-end"))) + :safe (lambda (x) + (and (listp x) + (cl-every #'consp x) + (cl-every #'stringp (mapcar #'car x)) + (cl-every #'stringp (mapcar #'cdr x))))) + +(defcustom org-export-global-macros nil + "Alist between macro names and expansion templates. + +This variable defines macro expansion templates available +globally. Associations follow the pattern + + (NAME . TEMPLATE) + +where NAME is a string beginning with a letter and consisting of +alphanumeric characters only. + +TEMPLATE is the string to which the macro is going to be +expanded. Inside, \"$1\", \"$2\"... are place-holders for +macro's arguments. Moreover, if the template starts with +\"(eval\", it will be parsed as an Elisp expression and evaluated +accordingly." + :group 'org-export-general + :version "26.1" + :package-version '(Org . "9.1") + :type '(repeat + (cons (string :tag "Name") + (string :tag "Template")))) + +(defcustom org-export-coding-system nil + "Coding system for the exported file." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'coding-system) + +(defcustom org-export-copy-to-kill-ring nil + "Non-nil means pushing export output to the kill ring. +This variable is ignored during asynchronous export." + :group 'org-export-general + :version "26.1" + :package-version '(Org . "8.3") + :type '(choice + (const :tag "Always" t) + (const :tag "When export is done interactively" if-interactive) + (const :tag "Never" nil))) + +(defcustom org-export-initial-scope 'buffer + "The initial scope when exporting with `org-export-dispatch'. +This variable can be either set to `buffer' or `subtree'." + :group 'org-export-general + :type '(choice + (const :tag "Export current buffer" buffer) + (const :tag "Export current subtree" subtree))) + +(defcustom org-export-show-temporary-export-buffer t + "Non-nil means show buffer after exporting to temp buffer. +When Org exports to a file, the buffer visiting that file is never +shown, but remains buried. However, when exporting to +a temporary buffer, that buffer is popped up in a second window. +When this variable is nil, the buffer remains buried also in +these cases." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-in-background nil + "Non-nil means export and publishing commands will run in background. +Results from an asynchronous export are never displayed +automatically. But you can retrieve them with `\\[org-export-stack]'." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-async-init-file nil + "File used to initialize external export process. + +Value must be either nil or an absolute file name. When nil, the +external process is launched like a regular Emacs session, +loading user's initialization file and any site specific +configuration. If a file is provided, it, and only it, is loaded +at start-up. + +Therefore, using a specific configuration makes the process to +load faster and the export more portable." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Regular startup" nil) + (file :tag "Specific start-up file" :must-match t))) + +(defcustom org-export-dispatch-use-expert-ui nil + "Non-nil means using a non-intrusive `org-export-dispatch'. +In that case, no help buffer is displayed. Though, an indicator +for current export scope is added to the prompt (\"b\" when +output is restricted to body only, \"s\" when it is restricted to +the current subtree, \"v\" when only visible elements are +considered for export, \"f\" when publishing functions should be +passed the FORCE argument and \"a\" when the export should be +asynchronous). Also, [?] allows switching back to standard +mode." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + + +;;; Defining Back-ends +;; +;; An export back-end is a structure with `org-export-backend' type +;; and `name', `parent', `transcoders', `options', `filters', `blocks' +;; and `menu' slots. +;; +;; At the lowest level, a back-end is created with +;; `org-export-create-backend' function. +;; +;; A named back-end can be registered with +;; `org-export-register-backend' function. A registered back-end can +;; later be referred to by its name, with `org-export-get-backend' +;; function. Also, such a back-end can become the parent of a derived +;; back-end from which slot values will be inherited by default. +;; `org-export-derived-backend-p' can check if a given back-end is +;; derived from a list of back-end names. +;; +;; `org-export-get-all-transcoders', `org-export-get-all-options' and +;; `org-export-get-all-filters' return the full alist of transcoders, +;; options and filters, including those inherited from ancestors. +;; +;; At a higher level, `org-export-define-backend' is the standard way +;; to define an export back-end. If the new back-end is similar to +;; a registered back-end, `org-export-define-derived-backend' may be +;; used instead. +;; +;; Eventually `org-export-barf-if-invalid-backend' returns an error +;; when a given back-end hasn't been registered yet. + +(cl-defstruct (org-export-backend (:constructor org-export-create-backend) + (:copier nil)) + name parent transcoders options filters blocks menu) + +;;;###autoload +(defun org-export-get-backend (name) + "Return export back-end named after NAME. +NAME is a symbol. Return nil if no such back-end is found." + (cl-find-if (lambda (b) (and (eq name (org-export-backend-name b)))) + org-export-registered-backends)) + +(defun org-export-register-backend (backend) + "Register BACKEND as a known export back-end. +BACKEND is a structure with `org-export-backend' type." + ;; Refuse to register an unnamed back-end. + (unless (org-export-backend-name backend) + (error "Cannot register a unnamed export back-end")) + ;; Refuse to register a back-end with an unknown parent. + (let ((parent (org-export-backend-parent backend))) + (when (and parent (not (org-export-get-backend parent))) + (error "Cannot use unknown \"%s\" back-end as a parent" parent))) + ;; If a back-end with the same name as BACKEND is already + ;; registered, replace it with BACKEND. Otherwise, simply add + ;; BACKEND to the list of registered back-ends. + (let ((old (org-export-get-backend (org-export-backend-name backend)))) + (if old (setcar (memq old org-export-registered-backends) backend) + (push backend org-export-registered-backends)))) + +(defun org-export-barf-if-invalid-backend (backend) + "Signal an error if BACKEND isn't defined." + (unless (org-export-backend-p backend) + (error "Unknown \"%s\" back-end: Aborting export" backend))) + +;;;###autoload +(defun org-export-derived-backend-p (backend &rest backends) + "Non-nil if BACKEND is derived from one of BACKENDS. +BACKEND is an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. BACKENDS is constituted of symbols." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (catch 'exit + (while (org-export-backend-parent backend) + (when (memq (org-export-backend-name backend) backends) + (throw 'exit t)) + (setq backend + (org-export-get-backend (org-export-backend-parent backend)))) + (memq (org-export-backend-name backend) backends)))) + +(defun org-export-get-all-transcoders (backend) + "Return full translation table for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are element or object types, as symbols, and values are +transcoders. + +Unlike to `org-export-backend-transcoders', this function +also returns transcoders inherited from parent back-ends, +if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((transcoders (org-export-backend-transcoders backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq transcoders + (append transcoders (org-export-backend-transcoders backend)))) + transcoders))) + +(defun org-export-get-all-options (backend) + "Return export options for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. See `org-export-options-alist' +for the shape of the return value. + +Unlike to `org-export-backend-options', this function also +returns options inherited from parent back-ends, if any. + +Return nil if BACKEND is unknown." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((options (org-export-backend-options backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq options (append options (org-export-backend-options backend)))) + options))) + +(defun org-export-get-all-filters (backend) + "Return complete list of filters for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are symbols and values lists of functions. + +Unlike to `org-export-backend-filters', this function also +returns filters inherited from parent back-ends, if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((filters (org-export-backend-filters backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq filters (append filters (org-export-backend-filters backend)))) + filters))) + +(defun org-export-define-backend (backend transcoders &rest body) + "Define a new back-end BACKEND. + +TRANSCODERS is an alist between object or element types and +functions handling them. + +These functions should return a string without any trailing +space, or nil. They must accept three arguments: the object or +element itself, its contents or nil when it isn't recursive and +the property list used as a communication channel. + +Contents, when not nil, are stripped from any global indentation +\(although the relative one is preserved). They also always end +with a single newline character. + +If, for a given type, no function is found, that element or +object type will simply be ignored, along with any blank line or +white space at its end. The same will happen if the function +returns the nil value. If that function returns the empty +string, the type will be ignored, but the blank lines or white +spaces will be kept. + +In addition to element and object types, one function can be +associated to the `template' (or `inner-template') symbol and +another one to the `plain-text' symbol. + +The former returns the final transcoded string, and can be used +to add a preamble and a postamble to document's body. It must +accept two arguments: the transcoded string and the property list +containing export options. A function associated to `template' +will not be applied if export has option \"body-only\". +A function associated to `inner-template' is always applied. + +The latter, when defined, is to be called on every text not +recognized as an element or an object. It must accept two +arguments: the text string and the information channel. It is an +appropriate place to protect special chars relative to the +back-end. + +BODY can start with pre-defined keyword arguments. The following +keywords are understood: + + :filters-alist + + Alist between filters and function, or list of functions, + specific to the back-end. See `org-export-filters-alist' for + a list of all allowed filters. Filters defined here + shouldn't make a back-end test, as it may prevent back-ends + derived from this one to behave properly. + + :menu-entry + + Menu entry for the export dispatcher. It should be a list + like: + + \\='(KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU) + + where : + + KEY is a free character selecting the back-end. + + DESCRIPTION-OR-ORDINAL is either a string or a number. + + If it is a string, is will be used to name the back-end in + its menu entry. If it is a number, the following menu will + be displayed as a sub-menu of the back-end with the same + KEY. Also, the number will be used to determine in which + order such sub-menus will appear (lowest first). + + ACTION-OR-MENU is either a function or an alist. + + If it is an action, it will be called with four + arguments (booleans): ASYNC, SUBTREEP, VISIBLE-ONLY and + BODY-ONLY. See `org-export-as' for further explanations on + some of them. + + If it is an alist, associations should follow the + pattern: + + \\='(KEY DESCRIPTION ACTION) + + where KEY, DESCRIPTION and ACTION are described above. + + Valid values include: + + \\='(?m \"My Special Back-end\" my-special-export-function) + + or + + \\='(?l \"Export to LaTeX\" + ((?p \"As PDF file\" org-latex-export-to-pdf) + (?o \"As PDF file and open\" + (lambda (a s v b) + (if a (org-latex-export-to-pdf t s v b) + (org-open-file + (org-latex-export-to-pdf nil s v b))))))) + + or the following, which will be added to the previous + sub-menu, + + \\='(?l 1 + ((?B \"As TEX buffer (Beamer)\" org-beamer-export-as-latex) + (?P \"As PDF file (Beamer)\" org-beamer-export-to-pdf))) + + :options-alist + + Alist between back-end specific properties introduced in + communication channel and how their value are acquired. See + `org-export-options-alist' for more information about + structure of the values." + (declare (indent 1)) + (let (filters menu-entry options) + (while (keywordp (car body)) + (let ((keyword (pop body))) + (pcase keyword + (:filters-alist (setq filters (pop body))) + (:menu-entry (setq menu-entry (pop body))) + (:options-alist (setq options (pop body))) + (_ (error "Unknown keyword: %s" keyword))))) + (org-export-register-backend + (org-export-create-backend :name backend + :transcoders transcoders + :options options + :filters filters + :menu menu-entry)))) + +(defun org-export-define-derived-backend (child parent &rest body) + "Create a new back-end as a variant of an existing one. + +CHILD is the name of the derived back-end. PARENT is the name of +the parent back-end. + +BODY can start with pre-defined keyword arguments. The following +keywords are understood: + + :filters-alist + + Alist of filters that will overwrite or complete filters + defined in PARENT back-end. See `org-export-filters-alist' + for a list of allowed filters. + + :menu-entry + + Menu entry for the export dispatcher. See + `org-export-define-backend' for more information about the + expected value. + + :options-alist + + Alist of back-end specific properties that will overwrite or + complete those defined in PARENT back-end. Refer to + `org-export-options-alist' for more information about + structure of the values. + + :translate-alist + + Alist of element and object types and transcoders that will + overwrite or complete transcode table from PARENT back-end. + Refer to `org-export-define-backend' for detailed information + about transcoders. + +As an example, here is how one could define \"my-latex\" back-end +as a variant of `latex' back-end with a custom template function: + + (org-export-define-derived-backend \\='my-latex \\='latex + :translate-alist \\='((template . my-latex-template-fun))) + +The back-end could then be called with, for example: + + (org-export-to-buffer \\='my-latex \"*Test my-latex*\")" + (declare (indent 2)) + (let (filters menu-entry options transcoders) + (while (keywordp (car body)) + (let ((keyword (pop body))) + (pcase keyword + (:filters-alist (setq filters (pop body))) + (:menu-entry (setq menu-entry (pop body))) + (:options-alist (setq options (pop body))) + (:translate-alist (setq transcoders (pop body))) + (_ (error "Unknown keyword: %s" keyword))))) + (org-export-register-backend + (org-export-create-backend :name child + :parent parent + :transcoders transcoders + :options options + :filters filters + :menu menu-entry)))) + + + +;;; The Communication Channel +;; +;; During export process, every function has access to a number of +;; properties. They are of two types: +;; +;; 1. Environment options are collected once at the very beginning of +;; the process, out of the original buffer and configuration. +;; Collecting them is handled by `org-export-get-environment' +;; function. +;; +;; Most environment options are defined through the +;; `org-export-options-alist' variable. +;; +;; 2. Tree properties are extracted directly from the parsed tree, +;; just before export, by `org-export--collect-tree-properties'. + +;;;; Environment Options +;; +;; Environment options encompass all parameters defined outside the +;; scope of the parsed data. They come from five sources, in +;; increasing precedence order: +;; +;; - Global variables, +;; - Buffer's attributes, +;; - Options keyword symbols, +;; - Buffer keywords, +;; - Subtree properties. +;; +;; The central internal function with regards to environment options +;; is `org-export-get-environment'. It updates global variables with +;; "#+BIND:" keywords, then retrieve and prioritize properties from +;; the different sources. +;; +;; The internal functions doing the retrieval are: +;; `org-export--get-global-options', +;; `org-export--get-buffer-attributes', +;; `org-export--parse-option-keyword', +;; `org-export--get-subtree-options' and +;; `org-export--get-inbuffer-options' +;; +;; Also, `org-export--list-bound-variables' collects bound variables +;; along with their value in order to set them as buffer local +;; variables later in the process. + +;;;###autoload +(defun org-export-get-environment (&optional backend subtreep ext-plist) + "Collect export options from the current buffer. + +Optional argument BACKEND is an export back-end, as returned by +`org-export-create-backend'. + +When optional argument SUBTREEP is non-nil, assume the export is +done against the current sub-tree. + +Third optional argument EXT-PLIST is a property list with +external parameters overriding Org default settings, but still +inferior to file-local settings." + ;; First install #+BIND variables since these must be set before + ;; global options are read. + (dolist (pair (org-export--list-bound-variables)) + (set (make-local-variable (car pair)) (nth 1 pair))) + ;; Get and prioritize export options... + (org-combine-plists + ;; ... from global variables... + (org-export--get-global-options backend) + ;; ... from an external property list... + ext-plist + ;; ... from in-buffer settings... + (org-export--get-inbuffer-options backend) + ;; ... and from subtree, when appropriate. + (and subtreep (org-export--get-subtree-options backend)))) + +(defun org-export--parse-option-keyword (options &optional backend) + "Parse an OPTIONS line and return values as a plist. +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies which back-end +specific items to read, if any." + (let ((line + (let ((s 0) alist) + (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-+\\)?[ \t]*" options s) + (setq s (match-end 0)) + (let ((value (match-string 2 options))) + (when value + (push (cons (match-string 1 options) + (read value)) + alist)))) + alist)) + ;; Priority is given to back-end specific options. + (all (append (org-export-get-all-options backend) + org-export-options-alist)) + (plist)) + (when line + (dolist (entry all plist) + (let ((item (nth 2 entry))) + (when item + (let ((v (assoc-string item line t))) + (when v (setq plist (plist-put plist (car entry) (cdr v))))))))))) + +(defun org-export--get-subtree-options (&optional backend) + "Get export options in subtree at point. +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies back-end used +for export. Return options as a plist." + ;; For each buffer keyword, create a headline property setting the + ;; same property in communication channel. The name for the + ;; property is the keyword with "EXPORT_" appended to it. + (org-with-wide-buffer + ;; Make sure point is at a heading. + (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t)) + (let ((plist + ;; EXPORT_OPTIONS are parsed in a non-standard way. Take + ;; care of them right from the start. + (let ((o (org-entry-get (point) "EXPORT_OPTIONS" 'selective))) + (and o (org-export--parse-option-keyword o backend)))) + ;; Take care of EXPORT_TITLE. If it isn't defined, use + ;; headline's title (with no todo keyword, priority cookie or + ;; tag) as its fallback value. + (cache (list + (cons "TITLE" + (or (org-entry-get (point) "EXPORT_TITLE" 'selective) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp) + (match-string-no-properties 4)))))) + ;; Look for both general keywords and back-end specific + ;; options, with priority given to the latter. + (options (append (org-export-get-all-options backend) + org-export-options-alist))) + ;; Handle other keywords. Then return PLIST. + (dolist (option options plist) + (let ((property (car option)) + (keyword (nth 1 option))) + (when keyword + (let ((value + (or (cdr (assoc keyword cache)) + (let ((v (org-entry-get (point) + (concat "EXPORT_" keyword) + 'selective))) + (push (cons keyword v) cache) v)))) + (when value + (setq plist + (plist-put plist + property + (cl-case (nth 4 option) + (parse + (org-element-parse-secondary-string + value (org-element-restriction 'keyword))) + (split (split-string value)) + (t value)))))))))))) + +(defun org-export--get-inbuffer-options (&optional backend) + "Return current buffer export options, as a plist. + +Optional argument BACKEND, when non-nil, is an export back-end, +as returned by, e.g., `org-export-create-backend'. It specifies +which back-end specific options should also be read in the +process. + +Assume buffer is in Org mode. Narrowing, if any, is ignored." + (let* ((case-fold-search t) + (options (append + ;; Priority is given to back-end specific options. + (org-export-get-all-options backend) + org-export-options-alist)) + plist to-parse) + (let ((find-properties + (lambda (keyword) + ;; Return all properties associated to KEYWORD. + (let (properties) + (dolist (option options properties) + (when (equal (nth 1 option) keyword) + (cl-pushnew (car option) properties))))))) + ;; Read options in the current buffer and return value. + (dolist (entry (org-collect-keywords + (nconc (delq nil (mapcar #'cadr options)) + '("FILETAGS" "OPTIONS")))) + (pcase entry + (`("OPTIONS" . ,values) + (setq plist + (apply #'org-combine-plists + plist + (mapcar (lambda (v) + (org-export--parse-option-keyword v backend)) + values)))) + (`("FILETAGS" . ,values) + (setq plist + (plist-put plist + :filetags + (org-uniquify + (cl-mapcan (lambda (v) (org-split-string v ":")) + values))))) + (`(,keyword . ,values) + (dolist (property (funcall find-properties keyword)) + (setq plist + (plist-put + plist property + ;; Handle value depending on specified BEHAVIOR. + (cl-case (nth 4 (assq property options)) + (parse + (unless (memq property to-parse) + (push property to-parse)) + ;; Even if `parse' implies `space' behavior, we + ;; separate line with "\n" so as to preserve + ;; line-breaks. + (mapconcat #'identity values "\n")) + (space + (mapconcat #'identity values " ")) + (newline + (mapconcat #'identity values "\n")) + (split + (cl-mapcan (lambda (v) (split-string v)) values)) + ((t) + (org-last values)) + (otherwise + (car values))))))))) + ;; Parse properties in TO-PARSE. Remove newline characters not + ;; involved in line breaks to simulate `space' behavior. + ;; Finally return options. + (dolist (p to-parse plist) + (let ((value (org-element-parse-secondary-string + (plist-get plist p) + (org-element-restriction 'keyword)))) + (org-element-map value 'plain-text + (lambda (s) + (org-element-set-element + s (replace-regexp-in-string "\n" " " s)))) + (setq plist (plist-put plist p value))))))) + +(defun org-export--get-export-attributes + (&optional backend subtreep visible-only body-only) + "Return properties related to export process, as a plist. +Optional arguments BACKEND, SUBTREEP, VISIBLE-ONLY and BODY-ONLY +are like the arguments with the same names of function +`org-export-as'." + (list :export-options (delq nil + (list (and subtreep 'subtree) + (and visible-only 'visible-only) + (and body-only 'body-only))) + :back-end backend + :translate-alist (org-export-get-all-transcoders backend) + :exported-data (make-hash-table :test #'eq :size 4001))) + +(defun org-export--get-buffer-attributes () + "Return properties related to buffer attributes, as a plist." + (list :input-buffer (buffer-name (buffer-base-buffer)) + :input-file (buffer-file-name (buffer-base-buffer)))) + +(defun org-export--get-global-options (&optional backend) + "Return global export options as a plist. +Optional argument BACKEND, if non-nil, is an export back-end, as +returned by, e.g., `org-export-create-backend'. It specifies +which back-end specific export options should also be read in the +process." + (let (plist + ;; Priority is given to back-end specific options. + (all (append (org-export-get-all-options backend) + org-export-options-alist))) + (dolist (cell all plist) + (let ((prop (car cell))) + (unless (plist-member plist prop) + (setq plist + (plist-put + plist + prop + ;; Evaluate default value provided. + (let ((value (eval (nth 3 cell) t))) + (if (eq (nth 4 cell) 'parse) + (org-element-parse-secondary-string + value (org-element-restriction 'keyword)) + value))))))))) + +(defun org-export--list-bound-variables () + "Return variables bound from BIND keywords in current buffer. +Also look for BIND keywords in setup files. The return value is +an alist where associations are (VARIABLE-NAME VALUE)." + (when org-export-allow-bind-keywords + (pcase (org-collect-keywords '("BIND")) + (`(("BIND" . ,values)) + (mapcar (lambda (v) (read (format "(%s)" v))) + values))))) + +;; defsubst org-export-get-parent must be defined before first use, +;; was originally defined in the topology section + +(defsubst org-export-get-parent (blob) + "Return BLOB parent or nil. +BLOB is the element or object considered." + (org-element-property :parent blob)) + +;;;; Tree Properties +;; +;; Tree properties are information extracted from parse tree. They +;; are initialized at the beginning of the transcoding process by +;; `org-export--collect-tree-properties'. +;; +;; Dedicated functions focus on computing the value of specific tree +;; properties during initialization. Thus, +;; `org-export--populate-ignore-list' lists elements and objects that +;; should be skipped during export, `org-export--get-min-level' gets +;; the minimal exportable level, used as a basis to compute relative +;; level for headlines. Eventually +;; `org-export--collect-headline-numbering' builds an alist between +;; headlines and their numbering. + +(defun org-export--collect-tree-properties (data info) + "Extract tree properties from parse tree. + +DATA is the parse tree from which information is retrieved. INFO +is a list holding export options. + +Following tree properties are set or updated: + +`:headline-offset' Offset between true level of headlines and + local level. An offset of -1 means a headline + of level 2 should be considered as a level + 1 headline in the context. + +`:headline-numbering' Alist of all headlines as key and the + associated numbering as value. + +`:id-alist' Alist of all ID references as key and associated file + as value. + +Return updated plist." + ;; Install the parse tree in the communication channel. + (setq info (plist-put info :parse-tree data)) + ;; 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)))) + ;; From now on, properties order doesn't matter: get the rest of the + ;; tree properties. + (org-combine-plists + info + (list :headline-numbering (org-export--collect-headline-numbering data info) + :id-alist + (org-element-map data 'link + (lambda (l) + (and (string= (org-element-property :type l) "id") + (let* ((id (org-element-property :path l)) + (file (car (org-id-find id)))) + (and file (cons id (file-relative-name file)))))))))) + +(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)) + (dolist (datum (org-element-contents data)) + (when (and (eq (org-element-type datum) 'headline) + (not (org-element-property :footnote-section-p datum)) + (not (memq datum (plist-get options :ignore-list)))) + (setq min-level (min (org-element-property :level datum) min-level)) + (when (= min-level 1) (throw 'exit 1)))) + ;; 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, numbered headlines in a parse tree. + +DATA is the parse tree. OPTIONS is the plist holding export +options. + +Return an alist whose key is a headline and value is its +associated numbering \(in the shape of a list of numbers) or nil +for a footnotes section." + (let ((numbering (make-vector org-export-max-depth 0))) + (org-element-map data 'headline + (lambda (headline) + (when (and (org-export-numbered-headline-p headline options) + (not (org-element-property :footnote-section-p headline))) + (let ((relative-level + (1- (org-export-get-relative-level headline options)))) + (cons + headline + (cl-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--selected-trees (data info) + "List headlines and inlinetasks with a select tag in their tree. +DATA is parsed data as returned by `org-element-parse-buffer'. +INFO is a plist holding export options." + (let ((select (cl-mapcan (lambda (tag) (org-tags-expand tag t)) + (plist-get info :select-tags)))) + (if (cl-some (lambda (tag) (member tag select)) (plist-get info :filetags)) + ;; If FILETAGS contains a select tag, every headline or + ;; inlinetask is returned. + (org-element-map data '(headline inlinetask) #'identity) + (letrec ((selected-trees nil) + (walk-data + (lambda (data genealogy) + (let ((type (org-element-type data))) + (cond + ((memq type '(headline inlinetask)) + (let ((tags (org-element-property :tags data))) + (if (cl-some (lambda (tag) (member tag select)) tags) + ;; When a select tag is found, mark full + ;; genealogy and every headline within the + ;; tree as acceptable. + (setq selected-trees + (append + genealogy + (org-element-map data '(headline inlinetask) + #'identity) + selected-trees)) + ;; If at a headline, continue searching in + ;; tree, recursively. + (when (eq type 'headline) + (dolist (el (org-element-contents data)) + (funcall walk-data el (cons data genealogy))))))) + ((or (eq type 'org-data) + (memq type org-element-greater-elements)) + (dolist (el (org-element-contents data)) + (funcall walk-data el genealogy)))))))) + (funcall walk-data data nil) + selected-trees)))) + +(defun org-export--skip-p (datum options selected excluded) + "Non-nil when element or object DATUM should be skipped during export. +OPTIONS is the plist holding export options. SELECTED, when +non-nil, is a list of headlines or inlinetasks belonging to +a tree with a select tag. EXCLUDED is a list of tags, as +strings. Any headline or inlinetask marked with one of those is +not exported." + (cl-case (org-element-type datum) + ((comment comment-block) + ;; Skip all comments and comment blocks. Make to keep maximum + ;; number of blank lines around the comment so as to preserve + ;; local structure of the document upon interpreting it back into + ;; Org syntax. + (let* ((previous (org-export-get-previous-element datum options)) + (before (or (org-element-property :post-blank previous) 0)) + (after (or (org-element-property :post-blank datum) 0))) + (when previous + (org-element-put-property previous :post-blank (max before after 1)))) + t) + (clock (not (plist-get options :with-clocks))) + (drawer + (let ((with-drawers-p (plist-get options :with-drawers))) + (or (not with-drawers-p) + (and (consp with-drawers-p) + ;; If `:with-drawers' value starts with `not', ignore + ;; every drawer whose name belong to that list. + ;; Otherwise, ignore drawers whose name isn't in that + ;; list. + (let ((name (org-element-property :drawer-name datum))) + (if (eq (car with-drawers-p) 'not) + (member-ignore-case name (cdr with-drawers-p)) + (not (member-ignore-case name with-drawers-p)))))))) + (fixed-width (not (plist-get options :with-fixed-width))) + ((footnote-definition footnote-reference) + (not (plist-get options :with-footnotes))) + ((headline inlinetask) + (let ((with-tasks (plist-get options :with-tasks)) + (todo (org-element-property :todo-keyword datum)) + (todo-type (org-element-property :todo-type datum)) + (archived (plist-get options :with-archived-trees)) + (tags (org-export-get-tags datum options nil t))) + (or + (and (eq (org-element-type datum) 'inlinetask) + (not (plist-get options :with-inlinetasks))) + ;; Ignore subtrees with an exclude tag. + (cl-some (lambda (tag) (member tag excluded)) tags) + ;; When a select tag is present in the buffer, ignore any tree + ;; without it. + (and selected (not (memq datum selected))) + ;; Ignore commented sub-trees. + (org-element-property :commentedp datum) + ;; Ignore archived subtrees if `:with-archived-trees' is nil. + (and (not archived) (org-element-property :archivedp datum)) + ;; Ignore tasks, if specified by `:with-tasks' property. + (and todo + (or (not with-tasks) + (and (memq with-tasks '(todo done)) + (not (eq todo-type with-tasks))) + (and (consp with-tasks) (not (member todo with-tasks)))))))) + ((latex-environment latex-fragment) (not (plist-get options :with-latex))) + (node-property + (let ((properties-set (plist-get options :with-properties))) + (cond ((null properties-set) t) + ((consp properties-set) + (not (member-ignore-case (org-element-property :key datum) + properties-set)))))) + (planning (not (plist-get options :with-planning))) + (property-drawer (not (plist-get options :with-properties))) + (statistics-cookie (not (plist-get options :with-statistics-cookies))) + (table (not (plist-get options :with-tables))) + (table-cell + (and (org-export-table-has-special-column-p + (org-export-get-parent-table datum)) + (org-export-first-sibling-p datum options))) + (table-row (org-export-table-row-is-special-p datum options)) + (timestamp + ;; `:with-timestamps' only applies to isolated timestamps + ;; objects, i.e. timestamp objects in a paragraph containing only + ;; timestamps and whitespaces. + (when (let ((parent (org-export-get-parent-element datum))) + (and (memq (org-element-type parent) '(paragraph verse-block)) + (not (org-element-map parent + (cons 'plain-text + (remq 'timestamp org-element-all-objects)) + (lambda (obj) + (or (not (stringp obj)) (org-string-nw-p obj))) + options t)))) + (cl-case (plist-get options :with-timestamps) + ((nil) t) + (active + (not (memq (org-element-property :type datum) '(active active-range)))) + (inactive + (not (memq (org-element-property :type datum) + '(inactive inactive-range))))))))) + + +;;; The Transcoder +;; +;; `org-export-data' reads a parse tree (obtained with, i.e. +;; `org-element-parse-buffer') and transcodes it into a specified +;; back-end output. It takes care of filtering out elements or +;; objects according to export options and organizing the output blank +;; lines and white space are preserved. The function memoizes its +;; results, so it is cheap to call it within transcoders. +;; +;; It is possible to modify locally the back-end used by +;; `org-export-data' or even use a temporary back-end by using +;; `org-export-data-with-backend'. +;; +;; `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 (_datum contents _info) contents) + (let ((transcoder (cdr (assq type (plist-get info :translate-alist))))) + (and (functionp transcoder) transcoder))))) + +;;;###autoload +(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 a string." + (or (gethash data (plist-get info :exported-data)) + ;; Handle broken links according to + ;; `org-export-with-broken-links'. + (cl-macrolet + ((broken-link-handler + (&rest body) + `(condition-case err + (progn ,@body) + (org-link-broken + (pcase (plist-get info :with-broken-links) + (`nil (user-error "Unable to resolve link: %S" (nth 1 err))) + (`mark (org-export-data + (format "[BROKEN LINK: %s]" (nth 1 err)) info)) + (_ nil)))))) + (let* ((type (org-element-type data)) + (parent (org-export-get-parent data)) + (results + (cond + ;; Ignored element/object. + ((memq data (plist-get info :ignore-list)) nil) + ;; Raw code. + ((eq type 'raw) (car (org-element-contents data))) + ;; 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)) + ;; Secondary string. + ((not type) + (mapconcat (lambda (obj) (org-export-data obj info)) data "")) + ;; Element/Object without contents or, as a special + ;; case, headline with archive tag and archived trees + ;; restricted to title only. + ((or (not (org-element-contents data)) + (and (eq type 'headline) + (eq (plist-get info :with-archived-trees) 'headline) + (org-element-property :archivedp data))) + (let ((transcoder (org-export-transcoder data info))) + (or (and (functionp transcoder) + (broken-link-handler + (funcall transcoder data nil info))) + ;; Export snippets never return a nil value so + ;; that white spaces following them are never + ;; ignored. + (and (eq type 'export-snippet) "")))) + ;; Element/Object with contents. + (t + (let ((transcoder (org-export-transcoder data info))) + (when transcoder + (let* ((greaterp (memq type org-element-greater-elements)) + (objectp + (and (not greaterp) + (memq type org-element-recursive-objects))) + (contents + (mapconcat + (lambda (element) (org-export-data element info)) + (org-element-contents + (if (or greaterp objectp) data + ;; Elements directly containing + ;; objects must have their indentation + ;; normalized first. + (org-element-normalize-contents + data + ;; When normalizing first paragraph + ;; of an item or + ;; a footnote-definition, ignore + ;; first line's indentation. + (and + (eq type 'paragraph) + (memq (org-element-type parent) + '(footnote-definition item)) + (eq (car (org-element-contents parent)) + data) + (eq (org-element-property :pre-blank parent) + 0))))) + ""))) + (broken-link-handler + (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) "") + ((memq type '(nil org-data plain-text raw)) results) + ;; Append the same white space between elements or objects + ;; as in the original buffer, and call appropriate filters. + (t + (org-export-filter-apply-functions + (plist-get info (intern (format ":filter-%s" type))) + (let ((blank (or (org-element-property :post-blank data) 0))) + (if (eq (org-element-class data parent) 'object) + (concat results (make-string blank ?\s)) + (concat (org-element-normalize-string results) + (make-string blank ?\n)))) + info))) + (plist-get info :exported-data)))))) + +(defun org-export-data-with-backend (data backend info) + "Convert DATA into BACKEND format. + +DATA is an element, an object, a secondary string or a string. +BACKEND is a symbol. INFO is a plist used as a communication +channel. + +Unlike to `org-export-with-backend', this function will +recursively convert DATA using BACKEND translation table." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + ;; Set-up a new communication channel with translations defined in + ;; BACKEND as the translate table and a new hash table for + ;; memoization. + (let ((new-info + (org-combine-plists + info + (list :back-end backend + :translate-alist (org-export-get-all-transcoders backend) + ;; Size of the hash table is reduced since this + ;; function will probably be used on small trees. + :exported-data (make-hash-table :test 'eq :size 401))))) + (prog1 (org-export-data data new-info) + ;; Preserve `:internal-references', as those do not depend on + ;; the back-end used; we need to make sure that any new + ;; reference when the temporary back-end was active gets through + ;; the default one. + (plist-put info :internal-references + (plist-get new-info :internal-references))))) + +(defun org-export-expand (blob contents &optional with-affiliated) + "Expand a parsed element or object to its original state. + +BLOB is either an element or an object. CONTENTS is its +contents, as a string or nil. + +When optional argument WITH-AFFILIATED is non-nil, add affiliated +keywords before output." + (let ((type (org-element-type blob))) + (concat (and with-affiliated + (eq (org-element-class blob) 'element) + (org-element--interpret-affiliated-keywords blob)) + (funcall (intern (format "org-element-%s-interpreter" type)) + blob contents)))) + + + +;;; The Filter System +;; +;; Filters allow end-users to tweak easily the transcoded output. +;; They are the functional counterpart of hooks, as every filter in +;; a set is applied to the return value of the previous one. +;; +;; Every set is back-end agnostic. Although, a filter is always +;; called, in addition to the string it applies to, with the back-end +;; used as argument, so it's easy for the end-user to add back-end +;; specific filters in the set. The communication channel, as +;; a plist, is required as the third argument. +;; +;; From the developer side, filters sets can be installed in the +;; process with the help of `org-export-define-backend', which +;; internally stores filters as an alist. Each association has a key +;; among the following symbols and a function or a list of functions +;; as value. +;; +;; - `:filter-options' applies to the property list containing export +;; options. Unlike to other filters, functions in this list accept +;; two arguments instead of three: the property list containing +;; export options and the back-end. Users can set its value through +;; `org-export-filter-options-functions' variable. +;; +;; - `:filter-parse-tree' applies directly to the complete parsed +;; tree. Users can set it through +;; `org-export-filter-parse-tree-functions' variable. +;; +;; - `:filter-body' applies to the body of the output, before template +;; translator chimes in. Users can set it through +;; `org-export-filter-body-functions' variable. +;; +;; - `:filter-final-output' applies to the final transcoded string. +;; Users can set it with `org-export-filter-final-output-functions' +;; variable. +;; +;; - `:filter-plain-text' applies to any string not recognized as Org +;; syntax. `org-export-filter-plain-text-functions' allows users to +;; configure it. +;; +;; - `:filter-TYPE' applies on the string returned after an element or +;; object of type TYPE has been transcoded. A user can modify +;; `org-export-filter-TYPE-functions' to install these filters. +;; +;; All filters sets are applied with +;; `org-export-filter-apply-functions' function. Filters in a set are +;; applied in a LIFO fashion. It allows developers to be sure that +;; their filters will be applied first. +;; +;; Filters properties are installed in communication channel with +;; `org-export-install-filters' function. +;; +;; Eventually, two hooks (`org-export-before-processing-hook' and +;; `org-export-before-parsing-hook') are run at the beginning of the +;; export process and just before parsing to allow for heavy structure +;; modifications. + + +;;;; Hooks + +(defvar org-export-before-processing-hook nil + "Hook run at the beginning of the export process. + +This is run before include keywords and macros are expanded and +Babel code blocks executed, on a copy of the original buffer +being exported. Visibility and narrowing are preserved. Point +is at the beginning of the buffer. + +Every function in this hook will be called with one argument: the +back-end currently used, as a symbol.") + +(defvar org-export-before-parsing-hook nil + "Hook run before parsing an export buffer. + +This is run after include keywords and macros have been expanded +and Babel code blocks executed, on a copy of the original buffer +being exported. Visibility and narrowing are preserved. Point +is at the beginning of the buffer. + +Every function in this hook will be called with one argument: the +back-end currently used, as a symbol.") + + +;;;; Special Filters + +(defvar org-export-filter-options-functions nil + "List of functions applied to the export options. +Each filter is called with two arguments: the export options, as +a plist, and the back-end, as a symbol. It must return +a property list containing export options.") + +(defvar org-export-filter-parse-tree-functions nil + "List of functions applied to the parsed tree. +Each filter is called with three arguments: the parse tree, as +returned by `org-element-parse-buffer', the back-end, as +a symbol, and the communication channel, as a plist. It must +return the modified parse tree to transcode.") + +(defvar org-export-filter-plain-text-functions nil + "List of functions applied to plain text. +Each filter is called with three arguments: a string which +contains no Org syntax, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + +(defvar org-export-filter-body-functions nil + "List of functions applied to transcoded body. +Each filter is called with three arguments: a string which +contains no Org syntax, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + +(defvar org-export-filter-final-output-functions nil + "List of functions applied to the transcoded string. +Each filter is called with three arguments: the full transcoded +string, the back-end, as a symbol, and the communication channel, +as a plist. It must return a string that will be used as the +final export output.") + + +;;;; Elements Filters + +(defvar org-export-filter-babel-call-functions nil + "List of functions applied to a transcoded babel-call. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-center-block-functions nil + "List of functions applied to a transcoded center block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-clock-functions nil + "List of functions applied to a transcoded clock. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-diary-sexp-functions nil + "List of functions applied to a transcoded diary-sexp. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-drawer-functions nil + "List of functions applied to a transcoded drawer. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-dynamic-block-functions nil + "List of functions applied to a transcoded dynamic-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-example-block-functions nil + "List of functions applied to a transcoded example-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-export-block-functions nil + "List of functions applied to a transcoded export-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-fixed-width-functions nil + "List of functions applied to a transcoded fixed-width. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-footnote-definition-functions nil + "List of functions applied to a transcoded footnote-definition. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-headline-functions nil + "List of functions applied to a transcoded headline. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-horizontal-rule-functions nil + "List of functions applied to a transcoded horizontal-rule. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inlinetask-functions nil + "List of functions applied to a transcoded inlinetask. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-item-functions nil + "List of functions applied to a transcoded item. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-keyword-functions nil + "List of functions applied to a transcoded keyword. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-latex-environment-functions nil + "List of functions applied to a transcoded latex-environment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-node-property-functions nil + "List of functions applied to a transcoded node-property. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-paragraph-functions nil + "List of functions applied to a transcoded paragraph. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-plain-list-functions nil + "List of functions applied to a transcoded plain-list. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-planning-functions nil + "List of functions applied to a transcoded planning. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-property-drawer-functions nil + "List of functions applied to a transcoded property-drawer. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-quote-block-functions nil + "List of functions applied to a transcoded quote block. +Each filter is called with three arguments: the transcoded quote +data, as a string, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + +(defvar org-export-filter-section-functions nil + "List of functions applied to a transcoded section. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-special-block-functions nil + "List of functions applied to a transcoded special block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-src-block-functions nil + "List of functions applied to a transcoded src-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-functions nil + "List of functions applied to a transcoded table. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-cell-functions nil + "List of functions applied to a transcoded table-cell. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-row-functions nil + "List of functions applied to a transcoded table-row. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-verse-block-functions nil + "List of functions applied to a transcoded verse block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + + +;;;; Objects Filters + +(defvar org-export-filter-bold-functions nil + "List of functions applied to transcoded bold text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-code-functions nil + "List of functions applied to transcoded code text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-entity-functions nil + "List of functions applied to a transcoded entity. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-export-snippet-functions nil + "List of functions applied to a transcoded export-snippet. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-footnote-reference-functions nil + "List of functions applied to a transcoded footnote-reference. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inline-babel-call-functions nil + "List of functions applied to a transcoded inline-babel-call. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inline-src-block-functions nil + "List of functions applied to a transcoded inline-src-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-italic-functions nil + "List of functions applied to transcoded italic text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-latex-fragment-functions nil + "List of functions applied to a transcoded latex-fragment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-line-break-functions nil + "List of functions applied to a transcoded line-break. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-link-functions nil + "List of functions applied to a transcoded link. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-radio-target-functions nil + "List of functions applied to a transcoded radio-target. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-statistics-cookie-functions nil + "List of functions applied to a transcoded statistics-cookie. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-strike-through-functions nil + "List of functions applied to transcoded strike-through text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-subscript-functions nil + "List of functions applied to a transcoded subscript. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-superscript-functions nil + "List of functions applied to a transcoded superscript. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-target-functions nil + "List of functions applied to a transcoded target. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-timestamp-functions nil + "List of functions applied to a transcoded timestamp. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-underline-functions nil + "List of functions applied to transcoded underline text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-verbatim-functions nil + "List of functions applied to transcoded verbatim text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + + +;;;; Filters Tools +;; +;; Internal function `org-export-install-filters' installs filters +;; hard-coded in back-ends (developer filters) and filters from global +;; variables (user filters) in the communication channel. +;; +;; Internal function `org-export-filter-apply-functions' takes care +;; about applying each filter in order to a given data. It ignores +;; filters returning a nil value but stops whenever a filter returns +;; an empty string. + +(defun org-export-filter-apply-functions (filters value info) + "Call every function in FILTERS. + +Functions are called with three arguments: a value, the export +back-end name and the communication channel. First function in +FILTERS is called with VALUE as its first argument. Second +function in FILTERS is called with the previous result as its +value, etc. + +Functions returning nil are skipped. Any function returning the +empty string ends the process, which returns the empty string. + +Call is done in a LIFO fashion, to be sure that developer +specified filters, if any, are called first." + (catch :exit + (let* ((backend (plist-get info :back-end)) + (backend-name (and backend (org-export-backend-name backend)))) + (dolist (filter filters value) + (let ((result (funcall filter value backend-name info))) + (cond ((not result)) + ((equal result "") (throw :exit "")) + (t (setq value result)))))))) + +(defun org-export-install-filters (info) + "Install filters properties in communication channel. +INFO is a plist containing the current communication channel. +Return the updated communication channel." + (let (plist) + ;; Install user-defined filters with `org-export-filters-alist' + ;; and filters already in INFO (through ext-plist mechanism). + (dolist (p org-export-filters-alist) + (let* ((prop (car p)) + (info-value (plist-get info prop)) + (default-value (symbol-value (cdr p)))) + (setq plist + (plist-put plist prop + ;; Filters in INFO will be called + ;; before those user provided. + (append (if (listp info-value) info-value + (list info-value)) + default-value))))) + ;; Prepend back-end specific filters to that list. + (dolist (p (org-export-get-all-filters (plist-get info :back-end))) + ;; Single values get consed, lists are appended. + (let ((key (car p)) (value (cdr p))) + (when value + (setq plist + (plist-put + plist key + (if (atom value) (cons value (plist-get plist key)) + (append value (plist-get plist key)))))))) + ;; Return new communication channel. + (org-combine-plists info plist))) + + + +;;; Core functions +;; +;; This is the room for the main function, `org-export-as', along with +;; its derivative, `org-export-string-as'. +;; `org-export--copy-to-kill-ring-p' determines if output of these +;; function should be added to kill ring. +;; +;; Note that `org-export-as' doesn't really parse the current buffer, +;; but a copy of it (with the same buffer-local variables and +;; visibility), where macros and include keywords are expanded and +;; Babel blocks are executed, if appropriate. +;; `org-export-with-buffer-copy' macro prepares that copy. +;; +;; File inclusion is taken care of by +;; `org-export-expand-include-keyword' and +;; `org-export--prepare-file-contents'. Structure wise, including +;; a whole Org file in a buffer often makes little sense. For +;; example, if the file contains a headline and the include keyword +;; was within an item, the item should contain the headline. That's +;; why file inclusion should be done before any structure can be +;; associated to the file, that is before parsing. +;; +;; `org-export-insert-default-template' is a command to insert +;; a default template (or a back-end specific template) at point or in +;; current subtree. + +(defun org-export-copy-buffer () + "Return a copy of the current buffer. +The copy preserves Org buffer-local variables, visibility and +narrowing." + (let ((copy-buffer-fun (org-export--generate-copy-script (current-buffer))) + (new-buf (generate-new-buffer (buffer-name)))) + (with-current-buffer new-buf + (funcall copy-buffer-fun) + (set-buffer-modified-p nil)) + new-buf)) + +(defmacro org-export-with-buffer-copy (&rest body) + "Apply BODY in a copy of the current buffer. +The copy preserves local variables, visibility and contents of +the original buffer. Point is at the beginning of the buffer +when BODY is applied." + (declare (debug t)) + (org-with-gensyms (buf-copy) + `(let ((,buf-copy (org-export-copy-buffer))) + (unwind-protect + (with-current-buffer ,buf-copy + (goto-char (point-min)) + (progn ,@body)) + (and (buffer-live-p ,buf-copy) + ;; Kill copy without confirmation. + (progn (with-current-buffer ,buf-copy + (restore-buffer-modified-p nil)) + (kill-buffer ,buf-copy))))))) + +(defun org-export--generate-copy-script (buffer) + "Generate a function duplicating BUFFER. + +The copy will preserve local variables, visibility, contents and +narrowing of the original buffer. If a region was active in +BUFFER, contents will be narrowed to that region instead. + +The resulting function can be evaluated at a later time, from +another buffer, effectively cloning the original buffer there. + +The function assumes BUFFER's major mode is `org-mode'." + (with-current-buffer buffer + (let ((str (org-with-wide-buffer (buffer-string))) + (narrowing + (if (org-region-active-p) + (list (region-beginning) (region-end)) + (list (point-min) (point-max)))) + (pos (point)) + (varvals + (let ((bound-variables (org-export--list-bound-variables)) + (varvals nil)) + (dolist (entry (buffer-local-variables (buffer-base-buffer))) + (when (consp entry) + (let ((var (car entry)) + (val (cdr entry))) + (and (not (memq var org-export-ignored-local-variables)) + (or (memq var + '(default-directory + buffer-file-name + buffer-file-coding-system)) + (assq var bound-variables) + (string-match "^\\(org-\\|orgtbl-\\)" + (symbol-name var))) + ;; Skip unreadable values, as they cannot be + ;; sent to external process. + (or (not val) (ignore-errors (read (format "%S" val)))) + (push (cons var val) varvals))))) + varvals)) + (ols + (let (ov-set) + (dolist (ov (overlays-in (point-min) (point-max))) + (let ((invis-prop (overlay-get ov 'invisible))) + (when invis-prop + (push (list (overlay-start ov) (overlay-end ov) + invis-prop) + ov-set)))) + ov-set))) + (lambda () + (let ((inhibit-modification-hooks t)) + ;; Set major mode. Ignore `org-mode-hook' as it has been run + ;; already in BUFFER. + (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode)) + ;; Copy specific buffer local variables and variables set + ;; through BIND keywords. + (pcase-dolist (`(,var . ,val) varvals) + (set (make-local-variable var) val)) + ;; Whole buffer contents. + (insert str) + ;; Narrowing. + (apply #'narrow-to-region narrowing) + ;; Current position of point. + (goto-char pos) + ;; Overlays with invisible property. + (pcase-dolist (`(,start ,end ,invis) ols) + (overlay-put (make-overlay start end) 'invisible invis))))))) + +(defun org-export--delete-comment-trees () + "Delete commented trees and commented inlinetasks in the buffer. +Narrowing, if any, is ignored." + (org-with-wide-buffer + (goto-char (point-min)) + (let* ((case-fold-search t) + (regexp (concat org-outline-regexp-bol ".*" org-comment-string))) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (org-element-property :commentedp element) + (delete-region (org-element-property :begin element) + (org-element-property :end element)))))))) + +(defun org-export--prune-tree (data info) + "Prune non exportable elements from DATA. +DATA is the parse tree to traverse. INFO is the plist holding +export info. Also set `:ignore-list' in INFO to a list of +objects which should be ignored during export, but not removed +from tree." + (letrec ((ignore nil) + ;; First find trees containing a select tag, if any. + (selected (org-export--selected-trees data info)) + ;; List tags that prevent export of headlines. + (excluded (cl-mapcan (lambda (tag) (org-tags-expand tag t)) + (plist-get info :exclude-tags))) + (walk-data + (lambda (data) + ;; Prune non-exportable elements and objects from tree. + ;; As a special case, special rows and cells from tables + ;; are stored in IGNORE, as they still need to be + ;; accessed during export. + (when data + (let ((type (org-element-type data))) + (if (org-export--skip-p data info selected excluded) + (if (memq type '(table-cell table-row)) (push data ignore) + (org-element-extract-element data)) + (if (and (eq type 'headline) + (eq (plist-get info :with-archived-trees) + 'headline) + (org-element-property :archivedp data)) + ;; If headline is archived but tree below has + ;; to be skipped, remove contents. + (org-element-set-contents data) + ;; Move into recursive objects/elements. + (mapc walk-data (org-element-contents data))) + ;; Move into secondary string, if any. + (dolist (p (cdr (assq type + org-element-secondary-value-alist))) + (mapc walk-data (org-element-property p data)))))))) + (definitions + ;; Collect definitions before possibly pruning them so as + ;; to avoid parsing them again if they are required. + (org-element-map data '(footnote-definition footnote-reference) + (lambda (f) + (cond + ((eq 'footnote-definition (org-element-type f)) f) + ((and (eq 'inline (org-element-property :type f)) + (org-element-property :label f)) + f) + (t nil)))))) + ;; If a select tag is active, also ignore the section before the + ;; first headline, if any. + (when selected + (let ((first-element (car (org-element-contents data)))) + (when (eq (org-element-type first-element) 'section) + (org-element-extract-element first-element)))) + ;; Prune tree and communication channel. + (funcall walk-data data) + (dolist (entry (append + ;; Priority is given to back-end specific options. + (org-export-get-all-options (plist-get info :back-end)) + org-export-options-alist)) + (when (eq (nth 4 entry) 'parse) + (funcall walk-data (plist-get info (car entry))))) + (let ((missing (org-export--missing-definitions data definitions))) + (funcall walk-data missing) + (org-export--install-footnote-definitions missing data)) + ;; Eventually set `:ignore-list'. + (plist-put info :ignore-list ignore))) + +(defun org-export--missing-definitions (tree definitions) + "List footnote definitions missing from TREE. +Missing definitions are searched within DEFINITIONS, which is +a list of footnote definitions or in the widened buffer." + (let* ((list-labels + (lambda (data) + ;; List all footnote labels encountered in DATA. Inline + ;; footnote references are ignored. + (org-element-map data 'footnote-reference + (lambda (reference) + (and (eq (org-element-property :type reference) 'standard) + (org-element-property :label reference)))))) + defined undefined missing-definitions) + ;; Partition DIRECT-REFERENCES between DEFINED and UNDEFINED + ;; references. + (let ((known-definitions + (org-element-map tree '(footnote-reference footnote-definition) + (lambda (f) + (and (or (eq (org-element-type f) 'footnote-definition) + (eq (org-element-property :type f) 'inline)) + (org-element-property :label f))))) + ) ;; seen + (dolist (l (funcall list-labels tree)) + (cond ;; ((member l seen)) + ((member l known-definitions) (push l defined)) + (t (push l undefined))))) + ;; Complete MISSING-DEFINITIONS by finding the definition of every + ;; undefined label, first by looking into DEFINITIONS, then by + ;; searching the widened buffer. This is a recursive process + ;; since definitions found can themselves contain an undefined + ;; reference. + (while undefined + (let* ((label (pop undefined)) + (definition + (cond + ((cl-some + (lambda (d) (and (equal (org-element-property :label d) label) + d)) + definitions)) + ((pcase (org-footnote-get-definition label) + (`(,_ ,beg . ,_) + (org-with-wide-buffer + (goto-char beg) + (let ((datum (org-element-context))) + (if (eq (org-element-type datum) 'footnote-reference) + datum + ;; Parse definition with contents. + (save-restriction + (narrow-to-region + (org-element-property :begin datum) + (org-element-property :end datum)) + (org-element-map (org-element-parse-buffer) + 'footnote-definition #'identity nil t)))))) + (_ nil))) + (t (user-error "Definition not found for footnote %s" label))))) + (push label defined) + (push definition missing-definitions) + ;; Look for footnote references within DEFINITION, since + ;; we may need to also find their definition. + (dolist (l (funcall list-labels definition)) + (unless (or (member l defined) ;Known label + (member l undefined)) ;Processed later + (push l undefined))))) + ;; MISSING-DEFINITIONS may contain footnote references with inline + ;; definitions. Make sure those are changed into real footnote + ;; definitions. + (mapcar (lambda (d) + (if (eq (org-element-type d) 'footnote-definition) d + (let ((label (org-element-property :label d))) + (apply #'org-element-create + 'footnote-definition `(:label ,label :post-blank 1) + (org-element-contents d))))) + missing-definitions))) + +(defun org-export--install-footnote-definitions (definitions tree) + "Install footnote definitions in tree. + +DEFINITIONS is the list of footnote definitions to install. TREE +is the parse tree. + +If there is a footnote section in TREE, definitions found are +appended to it. If `org-footnote-section' is non-nil, a new +footnote section containing all definitions is inserted in TREE. +Otherwise, definitions are appended at the end of the section +containing their first reference." + (cond + ((null definitions)) + ;; If there is a footnote section, insert definitions there. + ((let ((footnote-section + (org-element-map tree 'headline + (lambda (h) (and (org-element-property :footnote-section-p h) h)) + nil t))) + (and footnote-section + (apply #'org-element-adopt-elements + footnote-section + (nreverse definitions))))) + ;; If there should be a footnote section, create one containing all + ;; the definitions at the end of the tree. + (org-footnote-section + (org-element-adopt-elements + tree + (org-element-create 'headline + (list :footnote-section-p t + :level 1 + :title org-footnote-section + :raw-value org-footnote-section) + (apply #'org-element-create + 'section + nil + (nreverse definitions))))) + ;; Otherwise add each definition at the end of the section where it + ;; is first referenced. + (t + (letrec ((seen nil) + (insert-definitions + (lambda (data) + ;; Insert footnote definitions in the same section as + ;; their first reference in DATA. + (org-element-map data 'footnote-reference + (lambda (reference) + (when (eq (org-element-property :type reference) 'standard) + (let ((label (org-element-property :label reference))) + (unless (member label seen) + (push label seen) + (let ((definition + (cl-some + (lambda (d) + (and (equal (org-element-property :label d) + label) + d)) + definitions))) + (org-element-adopt-elements + (org-element-lineage reference '(section)) + definition) + ;; Also insert definitions for nested + ;; references, if any. + (funcall insert-definitions definition)))))))))) + (funcall insert-definitions tree))))) + +(defun org-export--remove-uninterpreted-data (data info) + "Change uninterpreted elements back into Org syntax. +DATA is a parse tree or a secondary string. INFO is a plist +containing export options. It is modified by side effect and +returned by the function." + (org-element-map data + '(entity bold italic latex-environment latex-fragment strike-through + subscript superscript underline) + (lambda (datum) + (let* ((type (org-element-type datum)) + (post-blank + (pcase (org-element-property :post-blank datum) + (`nil nil) + (n (make-string n (if (eq type 'latex-environment) ?\n ?\s))))) + (new + (cl-case type + ;; ... entities... + (entity + (and (not (plist-get info :with-entities)) + (list (concat (org-export-expand datum nil) + post-blank)))) + ;; ... emphasis... + ((bold italic strike-through underline) + (and (not (plist-get info :with-emphasize)) + (let ((marker (cl-case type + (bold "*") + (italic "/") + (strike-through "+") + (underline "_")))) + (append + (list marker) + (org-element-contents datum) + (list (concat marker post-blank)))))) + ;; ... LaTeX environments and fragments... + ((latex-environment latex-fragment) + (and (eq (plist-get info :with-latex) 'verbatim) + (list (concat (org-export-expand datum nil) + post-blank)))) + ;; ... sub/superscripts... + ((subscript superscript) + (let ((sub/super-p (plist-get info :with-sub-superscript)) + (bracketp (org-element-property :use-brackets-p datum))) + (and (or (not sub/super-p) + (and (eq sub/super-p '{}) (not bracketp))) + (append + (list (concat (if (eq type 'subscript) "_" "^") + (and bracketp "{"))) + (org-element-contents datum) + (list (concat (and bracketp "}") + post-blank))))))))) + (when new + ;; Splice NEW at DATUM location in parse tree. + (dolist (e new (org-element-extract-element datum)) + (unless (equal e "") (org-element-insert-before e datum)))))) + info nil nil t) + ;; Return modified parse tree. + data) + +;;;###autoload +(defun org-export-as + (backend &optional subtreep visible-only body-only ext-plist) + "Transcode current Org buffer into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +If narrowing is active in the current buffer, only transcode its +narrowed part. + +If a region is active, transcode that region. + +When optional argument SUBTREEP is non-nil, transcode the +sub-tree at point, extracting information from the headline +properties first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only return body +code, without surrounding template. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-barf-if-invalid-backend backend) + (save-excursion + (save-restriction + ;; Narrow buffer to an appropriate region or subtree for + ;; parsing. If parsing subtree, be sure to remove main + ;; headline, planning data and property drawer. + (cond ((org-region-active-p) + (narrow-to-region (region-beginning) (region-end))) + (subtreep + (org-narrow-to-subtree) + (goto-char (point-min)) + (org-end-of-meta-data) + (narrow-to-region (point) (point-max)))) + ;; Initialize communication channel with original buffer + ;; attributes, unavailable in its copy. + (let* ((org-export-current-backend (org-export-backend-name backend)) + (info (org-combine-plists + (org-export--get-export-attributes + backend subtreep visible-only body-only) + (org-export--get-buffer-attributes))) + (parsed-keywords + (delq nil + (mapcar (lambda (o) (and (eq (nth 4 o) 'parse) (nth 1 o))) + (append (org-export-get-all-options backend) + org-export-options-alist)))) + tree) + ;; Update communication channel and get parse tree. Buffer + ;; isn't parsed directly. Instead, all buffer modifications + ;; and consequent parsing are undertaken in a temporary copy. + (org-export-with-buffer-copy + ;; Run first hook with current back-end's name as argument. + (run-hook-with-args 'org-export-before-processing-hook + (org-export-backend-name backend)) + (org-export-expand-include-keyword) + (org-export--delete-comment-trees) + (org-macro-initialize-templates org-export-global-macros) + (org-macro-replace-all org-macro-templates parsed-keywords) + ;; Refresh buffer properties and radio targets after previous + ;; potentially invasive changes. + (org-set-regexps-and-options) + (org-update-radio-target-regexp) + ;; Possibly execute Babel code. Re-run a macro expansion + ;; specifically for {{{results}}} since inline source blocks + ;; may have generated some more. Refresh buffer properties + ;; and radio targets another time. + (when org-export-use-babel + (org-babel-exp-process-buffer) + (org-macro-replace-all '(("results" . "$1")) parsed-keywords) + (org-set-regexps-and-options) + (org-update-radio-target-regexp)) + ;; Run last hook with current back-end's name as argument. + ;; Update buffer properties and radio targets one last time + ;; before parsing. + (goto-char (point-min)) + (save-excursion + (run-hook-with-args 'org-export-before-parsing-hook + (org-export-backend-name backend))) + (org-set-regexps-and-options) + (org-update-radio-target-regexp) + ;; Update communication channel with environment. + (setq info + (org-combine-plists + info (org-export-get-environment backend subtreep ext-plist))) + ;; Pre-process citations environment, i.e. install + ;; bibliography list, and citation processor in INFO. + (org-cite-store-bibliography info) + (org-cite-store-export-processor info) + ;; De-activate uninterpreted data from parsed keywords. + (dolist (entry (append (org-export-get-all-options backend) + org-export-options-alist)) + (pcase entry + (`(,p ,_ ,_ ,_ parse) + (let ((value (plist-get info p))) + (plist-put info + p + (org-export--remove-uninterpreted-data value info)))) + (_ nil))) + ;; Install user's and developer's filters. + (setq info (org-export-install-filters info)) + ;; Call options filters and update export options. We do not + ;; use `org-export-filter-apply-functions' here since the + ;; arity of such filters is different. + (let ((backend-name (org-export-backend-name backend))) + (dolist (filter (plist-get info :filter-options)) + (let ((result (funcall filter info backend-name))) + (when result (setq info result))))) + ;; Parse buffer. + (setq tree (org-element-parse-buffer nil visible-only)) + ;; Prune tree from non-exported elements and transform + ;; uninterpreted elements or objects in both parse tree and + ;; communication channel. + (org-export--prune-tree tree info) + (org-export--remove-uninterpreted-data tree info) + ;; Call parse tree filters. + (setq tree + (org-export-filter-apply-functions + (plist-get info :filter-parse-tree) tree info)) + ;; Now tree is complete, compute its properties and add them + ;; to communication channel. + (setq info (org-export--collect-tree-properties tree info)) + ;; Process citations and bibliography. Replace each citation + ;; and "print_bibliography" keyword in the parse tree with + ;; the output of the selected citation export processor. + (org-cite-process-citations info) + (org-cite-process-bibliography info) + ;; Eventually transcode TREE. Wrap the resulting string into + ;; a template. + (let* ((body (org-element-normalize-string + (or (org-export-data tree info) ""))) + (inner-template (cdr (assq 'inner-template + (plist-get info :translate-alist)))) + (full-body (org-export-filter-apply-functions + (plist-get info :filter-body) + (if (not (functionp inner-template)) body + (funcall inner-template body info)) + info)) + (template (cdr (assq 'template + (plist-get info :translate-alist)))) + (output + (if (or (not (functionp template)) body-only) full-body + (funcall template full-body info)))) + ;; Call citation export finalizer. + (setq output (org-cite-finalize-export output info)) + ;; Remove all text properties since they cannot be + ;; retrieved from an external process. Finally call + ;; final-output filter and return result. + (org-no-properties + (org-export-filter-apply-functions + (plist-get info :filter-final-output) + output info)))))))) + +;;;###autoload +(defun org-export-string-as (string backend &optional body-only ext-plist) + "Transcode STRING into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +When optional argument BODY-ONLY is non-nil, only return body +code, without preamble nor postamble. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string." + (with-temp-buffer + (insert string) + (let ((org-inhibit-startup t)) (org-mode)) + (org-export-as backend nil nil body-only ext-plist))) + +;;;###autoload +(defun org-export-replace-region-by (backend) + "Replace the active region by its export to BACKEND. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end." + (unless (org-region-active-p) (user-error "No active region to replace")) + (insert + (org-export-string-as + (delete-and-extract-region (region-beginning) (region-end)) backend t))) + +;;;###autoload +(defun org-export-insert-default-template (&optional backend subtreep) + "Insert all export keywords with default values at beginning of line. + +BACKEND is a symbol referring to the name of a registered export +back-end, for which specific export options should be added to +the template, or `default' for default template. When it is nil, +the user will be prompted for a category. + +If SUBTREEP is non-nil, export configuration will be set up +locally for the subtree through node properties." + (interactive) + (unless (derived-mode-p 'org-mode) (user-error "Not in an Org mode buffer")) + (when (and subtreep (org-before-first-heading-p)) + (user-error "No subtree to set export options for")) + (let ((node (and subtreep (save-excursion (org-back-to-heading t) (point)))) + (backend + (or backend + (intern + (org-completing-read + "Options category: " + (cons "default" + (mapcar (lambda (b) + (symbol-name (org-export-backend-name b))) + org-export-registered-backends)) + nil t)))) + options keywords) + ;; Populate OPTIONS and KEYWORDS. + (dolist (entry (cond ((eq backend 'default) org-export-options-alist) + ((org-export-backend-p backend) + (org-export-backend-options backend)) + (t (org-export-backend-options + (org-export-get-backend backend))))) + (let ((keyword (nth 1 entry)) + (option (nth 2 entry))) + (cond + (keyword (unless (assoc keyword keywords) + (let ((value + (if (eq (nth 4 entry) 'split) + (mapconcat #'identity (eval (nth 3 entry) t) " ") + (eval (nth 3 entry) t)))) + (push (cons keyword value) keywords)))) + (option (unless (assoc option options) + (push (cons option (eval (nth 3 entry) t)) options)))))) + ;; Move to an appropriate location in order to insert options. + (unless subtreep (beginning-of-line)) + ;; First (multiple) OPTIONS lines. Never go past fill-column. + (when options + (let ((items + (mapcar + (lambda (opt) (format "%s:%S" (car opt) (cdr opt))) + (sort options (lambda (k1 k2) (string< (car k1) (car k2))))))) + (if subtreep + (org-entry-put + node "EXPORT_OPTIONS" (mapconcat #'identity items " ")) + (while items + (insert "#+options:") + (let ((width 10)) + (while (and items + (< (+ width (length (car items)) 1) fill-column)) + (let ((item (pop items))) + (insert " " item) + (cl-incf width (1+ (length item)))))) + (insert "\n"))))) + ;; Then the rest of keywords, in the order specified in either + ;; `org-export-options-alist' or respective export back-ends. + (dolist (key (nreverse keywords)) + (let ((val (cond ((equal (car key) "DATE") + (or (cdr key) + (with-temp-buffer + (org-insert-time-stamp nil)))) + ((equal (car key) "TITLE") + (or (let ((visited-file + (buffer-file-name (buffer-base-buffer)))) + (and visited-file + (file-name-sans-extension + (file-name-nondirectory visited-file)))) + (buffer-name (buffer-base-buffer)))) + (t (cdr key))))) + (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val) + (insert + (format "#+%s:%s\n" + (downcase (car key)) + (if (org-string-nw-p val) (format " %s" val) "")))))))) + +(defun org-export-expand-include-keyword (&optional included dir footnotes) + "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. Optional argument FOOTNOTES is a hash-table used for +storing and resolving footnotes. It is created automatically." + (let ((includer-file (buffer-file-name (buffer-base-buffer))) + (case-fold-search t) + (file-prefix (make-hash-table :test #'equal)) + (current-prefix 0) + (footnotes (or footnotes (make-hash-table :test #'equal))) + (include-re "^[ \t]*#\\+INCLUDE:")) + ;; If :minlevel is not set the text-property + ;; `:org-include-induced-level' will be used to determine the + ;; relative level when expanding INCLUDE. + ;; Only affects included Org documents. + (goto-char (point-min)) + (while (re-search-forward include-re nil t) + (put-text-property (line-beginning-position) (line-end-position) + :org-include-induced-level + (1+ (org-reduced-level (or (org-current-level) 0))))) + ;; Expand INCLUDE keywords. + (goto-char (point-min)) + (while (re-search-forward include-re nil t) + (unless (org-in-commented-heading-p) + (let ((element (save-match-data (org-element-at-point)))) + (when (eq (org-element-type element) 'keyword) + (beginning-of-line) + ;; Extract arguments from keyword's value. + (let* ((value (org-element-property :value element)) + (ind (current-indentation)) + location + (coding-system-for-read + (or (and (string-match ":coding +\\(\\S-+\\)>" value) + (prog1 (intern (match-string 1 value)) + (setq value (replace-match "" nil nil value)))) + coding-system-for-read)) + (file + (and (string-match "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" + value) + (prog1 + (save-match-data + (let ((matched (match-string 1 value))) + (when (string-match "\\(::\\(.*?\\)\\)\"?\\'" + matched) + (setq location (match-string 2 matched)) + (setq matched + (replace-match "" nil nil matched 1))) + (expand-file-name (org-strip-quotes matched) + dir))) + (setq value (replace-match "" nil nil value))))) + (only-contents + (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?" + value) + (prog1 (org-not-nil (match-string 1 value)) + (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) 'literal) + ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value) + 'literal) + ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value) + 'literal))) + ;; 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))) + (get-text-property (point) + :org-include-induced-level)))) + (args (and (eq env 'literal) (match-string 1 value))) + (block (and (string-match "\\<\\(\\S-+\\)\\>" value) + (match-string 1 value)))) + ;; Remove keyword. + (delete-region (point) (line-beginning-position 2)) + (cond + ((not file) nil) + ((not (file-readable-p file)) + (error "Cannot include file %s" file)) + ;; Check if files has already been parsed. Look after + ;; inclusion lines too, as different parts of the same + ;; file can be included too. + ((member (list file lines) included) + (error "Recursive file inclusion: %s" file)) + (t + (cond + ((eq env 'literal) + (insert + (let ((ind-str (make-string ind ?\s)) + (arg-str (if (stringp args) (format " %s" args) "")) + (contents + (org-escape-code-in-string + (org-export--prepare-file-contents file lines)))) + (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n" + ind-str block arg-str contents ind-str block)))) + ((stringp block) + (insert + (let ((ind-str (make-string ind ?\s)) + (contents + (org-export--prepare-file-contents file lines))) + (format "%s#+BEGIN_%s\n%s%s#+END_%s\n" + ind-str block contents ind-str block)))) + (t + (insert + (with-temp-buffer + (let ((org-inhibit-startup t) + (lines + (if location + (org-export--inclusion-absolute-lines + file location only-contents lines) + lines))) + (org-mode) + (insert + (org-export--prepare-file-contents + file lines ind minlevel + (or (gethash file file-prefix) + (puthash file + (cl-incf current-prefix) + file-prefix)) + footnotes + includer-file))) + (org-export-expand-include-keyword + (cons (list file lines) included) + (file-name-directory file) + footnotes) + (buffer-string))))) + ;; Expand footnotes after all files have been + ;; included. Footnotes are stored at end of buffer. + (unless included + (org-with-wide-buffer + (goto-char (point-max)) + (maphash (lambda (k v) + (insert (format "\n[fn:%s] %s\n" k v))) + footnotes)))))))))))) + +(defun org-export--inclusion-absolute-lines (file location only-contents lines) + "Resolve absolute lines for an included file with file-link. + +FILE is string file-name of the file to include. LOCATION is a +string name within FILE to be included (located via +`org-link-search'). If ONLY-CONTENTS is non-nil only the +contents of the named element will be included, as determined +Org-Element. If LINES is non-nil only those lines are included. + +Return a string of lines to be included in the format expected by +`org-export--prepare-file-contents'." + (with-temp-buffer + (insert-file-contents file) + (unless (eq major-mode 'org-mode) + (let ((org-inhibit-startup t)) (org-mode))) + (condition-case err + ;; Enforce consistent search. + (let ((org-link-search-must-match-exact-headline nil)) + (org-link-search location)) + (error + (error "%s for %s::%s" (error-message-string err) file location))) + (let* ((element (org-element-at-point)) + (contents-begin + (and only-contents (org-element-property :contents-begin element)))) + (narrow-to-region + (or contents-begin (org-element-property :begin element)) + (org-element-property (if contents-begin :contents-end :end) element)) + (when (and only-contents + (memq (org-element-type element) '(headline inlinetask))) + ;; Skip planning line and property-drawer. + (goto-char (point-min)) + (when (looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at org-property-drawer-re) (goto-char (match-end 0))) + (unless (bolp) (forward-line)) + (narrow-to-region (point) (point-max)))) + (when lines + (org-skip-whitespace) + (beginning-of-line) + (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 beg) + (forward-line (1- lend)) + (point)))) + (narrow-to-region beg end))) + (let ((end (point-max))) + (goto-char (point-min)) + (widen) + (let ((start-line (line-number-at-pos))) + (format "%d-%d" + start-line + (save-excursion + (+ start-line + (let ((counter 0)) + (while (< (point) end) (cl-incf counter) (forward-line)) + counter)))))))) + +(defun org-export--update-included-link (file-dir includer-dir) + "Update relative file name of link at point, if possible. + +FILE-DIR is the directory of the file being included. +INCLUDER-DIR is the directory of the file where the inclusion is +going to happen. + +Move point after the link." + (let* ((link (org-element-link-parser)) + (path (org-element-property :path link))) + (if (or (not (string= "file" (org-element-property :type link))) + (file-remote-p path) + (file-name-absolute-p path)) + (goto-char (org-element-property :end link)) + (let ((new-path (file-relative-name (expand-file-name path file-dir) + includer-dir)) + (new-link (org-element-copy link))) + (org-element-put-property new-link :path new-path) + (when (org-element-property :contents-begin link) + (org-element-adopt-elements new-link + (buffer-substring + (org-element-property :contents-begin link) + (org-element-property :contents-end link)))) + (delete-region (org-element-property :begin link) + (org-element-property :end link)) + (insert (org-element-interpret-data new-link)))))) + +(defun org-export--prepare-file-contents + (file &optional lines ind minlevel id footnotes includer) + "Prepare contents of FILE for inclusion and return it 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 (e.g., 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. + +Optional argument ID is an integer that will be inserted before +each footnote definition and reference if FILE is an Org file. +This is useful to avoid conflicts when more than one Org file +with footnotes is included in a document. + +Optional argument FOOTNOTES is a hash-table to store footnotes in +the included document. + +Optional argument INCLUDER is the file name where the inclusion +is to happen." + (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))) + ;; Adapt all file links within the included document that contain + ;; relative paths in order to make these paths relative to the + ;; base document, or absolute. + (when includer + (let ((file-dir (file-name-directory file)) + (includer-dir (file-name-directory includer))) + (unless (file-equal-p file-dir includer-dir) + (goto-char (point-min)) + (unless (eq major-mode 'org-mode) + (let ((org-inhibit-startup t)) (org-mode))) ;set regexps + (let ((regexp (concat org-link-plain-re "\\|" org-link-angle-re))) + (while (re-search-forward org-link-any-re nil t) + (let ((link (save-excursion + (forward-char -1) + (save-match-data (org-element-context))))) + (when (eq 'link (org-element-type link)) + ;; Look for file links within link's description. + ;; Org doesn't support such construct, but + ;; `org-export-insert-image-links' may activate + ;; them. + (let ((contents-begin + (org-element-property :contents-begin link)) + (begin (org-element-property :begin link))) + (when contents-begin + (save-excursion + (goto-char (org-element-property :contents-end link)) + (while (re-search-backward regexp contents-begin t) + (save-match-data + (org-export--update-included-link + file-dir includer-dir)) + (goto-char (match-beginning 0))))) + ;; Update current link, if necessary. + (when (string= "file" (org-element-property :type link)) + (goto-char begin) + (org-export--update-included-link + file-dir includer-dir)))))))))) + ;; 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 (and ind (> ind 0)) + (unless (eq major-mode 'org-mode) + (let ((org-inhibit-startup t)) (org-mode))) + (goto-char (point-min)) + (let ((ind-str (make-string ind ?\s))) + (while (not (or (eobp) (looking-at org-outline-regexp-bol))) + ;; Do not move footnote definitions out of column 0. + (unless (and (looking-at org-footnote-definition-re) + (eq (org-element-type (org-element-at-point)) + 'footnote-definition)) + (insert ind-str)) + (forward-line)))) + ;; When MINLEVEL is specified, compute minimal level for headlines + ;; in the file (CUR-MIN), and remove stars to each headline so + ;; that headlines with minimal level have a level of MINLEVEL. + (when minlevel + (unless (eq major-mode 'org-mode) + (let ((org-inhibit-startup t)) (org-mode))) + (org-with-limited-levels + (let ((levels (org-map-entries + (lambda () (org-reduced-level (org-current-level)))))) + (when levels + (let ((offset (- minlevel (apply #'min levels)))) + (unless (zerop offset) + (when org-odd-levels-only (setq offset (* offset 2))) + ;; Only change stars, don't bother moving whole + ;; sections. + (org-map-entries + (lambda () + (if (< offset 0) (delete-char (abs offset)) + (insert (make-string offset ?*))))))))))) + ;; Append ID to all footnote references and definitions, so they + ;; become file specific and cannot collide with footnotes in other + ;; included files. Further, collect relevant footnote definitions + ;; outside of LINES, in order to reintroduce them later. + (when id + (let ((marker-min (point-min-marker)) + (marker-max (point-max-marker)) + (get-new-label + (lambda (label) + ;; Generate new label from LABEL by prefixing it with + ;; "-ID-". + (format "-%d-%s" id label))) + (set-new-label + (lambda (f old new) + ;; Replace OLD label with NEW in footnote F. + (save-excursion + (goto-char (+ (org-element-property :begin f) 4)) + (looking-at (regexp-quote old)) + (replace-match new)))) + (seen-alist)) + (goto-char (point-min)) + (while (re-search-forward org-footnote-re nil t) + (let ((footnote (save-excursion + (backward-char) + (org-element-context)))) + (when (memq (org-element-type footnote) + '(footnote-definition footnote-reference)) + (let* ((label (org-element-property :label footnote))) + ;; Update the footnote-reference at point and collect + ;; the new label, which is only used for footnotes + ;; outsides LINES. + (when label + (let ((seen (cdr (assoc label seen-alist)))) + (if seen (funcall set-new-label footnote label seen) + (let ((new (funcall get-new-label label))) + (push (cons label new) seen-alist) + (org-with-wide-buffer + (let* ((def (org-footnote-get-definition label)) + (beg (nth 1 def))) + (when (and def + (or (< beg marker-min) + (>= beg marker-max))) + ;; Store since footnote-definition is + ;; outside of LINES. + (puthash new + (org-element-normalize-string (nth 3 def)) + footnotes)))) + (funcall set-new-label footnote label new))))))))) + (set-marker marker-min nil) + (set-marker marker-max nil))) + (org-element-normalize-string (buffer-string)))) + +(defun org-export--copy-to-kill-ring-p () + "Return a non-nil value when output should be added to the kill ring. +See also `org-export-copy-to-kill-ring'." + (if (eq org-export-copy-to-kill-ring 'if-interactive) + (not (or executing-kbd-macro noninteractive)) + (eq org-export-copy-to-kill-ring t))) + + + +;;; Tools For Back-Ends +;; +;; A whole set of tools is available to help build new exporters. Any +;; function general enough to have its use across many back-ends +;; should be added here. + +;;;; For Affiliated Keywords +;; +;; `org-export-read-attribute' reads a property from a given element +;; as a plist. It can be used to normalize affiliated keywords' +;; syntax. +;; +;; Since captions can span over multiple lines and accept dual values, +;; their internal representation is a bit tricky. Therefore, +;; `org-export-get-caption' transparently returns a given element's +;; caption as a secondary string. + +(defun org-export-read-attribute (attribute element &optional property) + "Turn ATTRIBUTE property from ELEMENT into a plist. + +When optional argument PROPERTY is non-nil, return the value of +that property within attributes. + +This function assumes attributes are defined as \":keyword +value\" pairs. It is appropriate for `:attr_html' like +properties. + +All values will become strings except the empty string and +\"nil\", which will become nil. Also, values containing only +double quotes will be read as-is, which means that \"\" value +will become the empty string." + (let* ((prepare-value + (lambda (str) + (save-match-data + (cond ((member str '(nil "" "nil")) nil) + ((string-match "^\"\\(\"+\\)?\"$" str) + (or (match-string 1 str) "")) + (t str))))) + (attributes + (let ((value (org-element-property attribute element))) + (when value + (let ((s (mapconcat #'identity value " ")) result) + (while (string-match + "\\(?:^\\|[ \t]+\\)\\(:[-a-zA-Z0-9_]+\\)\\([ \t]+\\|$\\)" + s) + (let ((value (substring s 0 (match-beginning 0)))) + (push (funcall prepare-value value) result)) + (push (intern (match-string 1 s)) result) + (setq s (substring s (match-end 0)))) + ;; Ignore any string before first property with `cdr'. + (cdr (nreverse (cons (funcall prepare-value s) result)))))))) + (if property (plist-get attributes property) attributes))) + +(defun org-export-get-caption (element &optional short) + "Return caption from ELEMENT as a secondary string. + +When optional argument SHORT is non-nil, return short caption, as +a secondary string, instead. + +Caption lines are separated by a white space." + (let ((full-caption (org-element-property :caption element)) + (get (if short #'cdr #'car)) + caption) + (dolist (line full-caption) + (pcase (funcall get line) + (`nil nil) + (c + (setq caption + (nconc (list " ") + (copy-sequence c) caption))))) + (cdr caption))) + + +;;;; For Derived Back-ends +;; +;; `org-export-with-backend' is a function allowing to locally use +;; another back-end to transcode some object or element. In a derived +;; back-end, it may be used as a fall-back function once all specific +;; cases have been treated. + +(defun org-export-with-backend (backend data &optional contents info) + "Call a transcoder from BACKEND on DATA. +BACKEND is an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. DATA is an Org element, object, secondary +string or string. CONTENTS, when non-nil, is the transcoded +contents of DATA element, as a string. INFO, when non-nil, is +the communication channel used for export, as a plist." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-barf-if-invalid-backend backend) + (let ((type (org-element-type data))) + (when (memq type '(nil org-data raw)) + (error "No foreign transcoder available")) + (let* ((all-transcoders (org-export-get-all-transcoders backend)) + (transcoder (cdr (assq type all-transcoders)))) + (unless (functionp transcoder) (error "No foreign transcoder available")) + (let ((new-info + (org-combine-plists + info (list + :back-end backend + :translate-alist all-transcoders + :exported-data (make-hash-table :test #'eq :size 401))))) + ;; `:internal-references' are shared across back-ends. + (prog1 (if (eq type 'plain-text) + (funcall transcoder data new-info) + (funcall transcoder data contents new-info)) + (plist-put info :internal-references + (plist-get new-info :internal-references))))))) + + +;;;; For Export Snippets +;; +;; Every export snippet is transmitted to the back-end. Though, the +;; latter will only retain one type of export-snippet, ignoring +;; others, based on the former's target back-end. The function +;; `org-export-snippet-backend' returns that back-end for a given +;; export-snippet. + +(defun org-export-snippet-backend (export-snippet) + "Return EXPORT-SNIPPET targeted back-end as a symbol. +Translation, with `org-export-snippet-translation-alist', is +applied." + (let ((back-end (org-element-property :back-end export-snippet))) + (intern + (or (cdr (assoc back-end org-export-snippet-translation-alist)) + back-end)))) + + +;;;; For Footnotes +;; +;; `org-export-collect-footnote-definitions' is a tool to list +;; actually used footnotes definitions in the whole parse tree, or in +;; a headline, in order to add footnote listings throughout the +;; transcoded data. +;; +;; `org-export-footnote-first-reference-p' is a predicate used by some +;; back-ends, when they need to attach the footnote definition only to +;; the first occurrence of the corresponding label. +;; +;; `org-export-get-footnote-definition' and +;; `org-export-get-footnote-number' provide easier access to +;; additional information relative to a footnote reference. + +(defun org-export-get-footnote-definition (footnote-reference info) + "Return definition of FOOTNOTE-REFERENCE as parsed data. +INFO is the plist used as a communication channel. If no such +definition can be found, raise an error." + (let ((label (org-element-property :label footnote-reference))) + (if (not label) (org-element-contents footnote-reference) + (let ((cache (or (plist-get info :footnote-definition-cache) + (let ((hash (make-hash-table :test #'equal))) + (plist-put info :footnote-definition-cache hash) + hash)))) + (or + (gethash label cache) + (puthash label + (org-element-map (plist-get info :parse-tree) + '(footnote-definition footnote-reference) + (lambda (f) + (cond + ;; Skip any footnote with a different label. + ;; Also skip any standard footnote reference + ;; with the same label since those cannot + ;; contain a definition. + ((not (equal (org-element-property :label f) label)) nil) + ((eq (org-element-property :type f) 'standard) nil) + ((org-element-contents f)) + ;; Even if the contents are empty, we can not + ;; return nil since that would eventually raise + ;; the error. Instead, return the equivalent + ;; empty string. + (t ""))) + info t) + cache) + (error "Definition not found for footnote %s" label)))))) + +(defun org-export--footnote-reference-map + (function data info &optional body-first) + "Apply FUNCTION on every footnote reference in DATA. +INFO is a plist containing export state. By default, as soon as +a new footnote reference is encountered, FUNCTION is called onto +its definition. However, if BODY-FIRST is non-nil, this step is +delayed until the end of the process." + (letrec ((definitions nil) + (seen-refs nil) + (search-ref + (lambda (data delayp) + ;; Search footnote references through DATA, filling + ;; SEEN-REFS along the way. When DELAYP is non-nil, + ;; store footnote definitions so they can be entered + ;; later. + (org-element-map data 'footnote-reference + (lambda (f) + (funcall function f) + (let ((--label (org-element-property :label f))) + (unless (and --label (member --label seen-refs)) + (when --label (push --label seen-refs)) + ;; Search for subsequent references in footnote + ;; definition so numbering follows reading + ;; logic, unless DELAYP in non-nil. + (cond + (delayp + (push (org-export-get-footnote-definition f info) + definitions)) + ;; Do not force entering inline definitions, + ;; since `org-element-map' already traverses + ;; them at the right time. + ((eq (org-element-property :type f) 'inline)) + (t (funcall search-ref + (org-export-get-footnote-definition f info) + nil)))))) + info nil + ;; Don't enter footnote definitions since it will + ;; happen when their first reference is found. + ;; Moreover, if DELAYP is non-nil, make sure we + ;; postpone entering definitions of inline references. + (if delayp '(footnote-definition footnote-reference) + 'footnote-definition))))) + (funcall search-ref data body-first) + (funcall search-ref (nreverse definitions) nil))) + +(defun org-export-collect-footnote-definitions (info &optional data body-first) + "Return an alist between footnote numbers, labels and definitions. + +INFO is the current export state, as a plist. + +Definitions are collected throughout the whole parse tree, or +DATA when non-nil. + +Sorting is done by order of references. As soon as a new +reference is encountered, other references are searched within +its definition. However, if BODY-FIRST is non-nil, this step is +delayed after the whole tree is checked. This alters results +when references are found in footnote definitions. + +Definitions either appear as Org data or as a secondary string +for inlined footnotes. Unreferenced definitions are ignored." + (let ((n 0) labels alist) + (org-export--footnote-reference-map + (lambda (f) + ;; Collect footnote number, label and definition. + (let ((l (org-element-property :label f))) + (unless (and l (member l labels)) + (cl-incf n) + (push (list n l (org-export-get-footnote-definition f info)) alist)) + (when l (push l labels)))) + (or data (plist-get info :parse-tree)) info body-first) + (nreverse alist))) + +(defun org-export-footnote-first-reference-p + (footnote-reference info &optional data body-first) + "Non-nil when a footnote reference is the first one for its label. + +FOOTNOTE-REFERENCE is the footnote reference being considered. +INFO is a plist containing current export state. + +Search is done throughout the whole parse tree, or DATA when +non-nil. + +By default, as soon as a new footnote reference is encountered, +other references are searched within its definition. However, if +BODY-FIRST is non-nil, this step is delayed after the whole tree +is checked. This alters results when references are found in +footnote definitions." + (let ((label (org-element-property :label footnote-reference))) + ;; Anonymous footnotes are always a first reference. + (or (not label) + (catch 'exit + (org-export--footnote-reference-map + (lambda (f) + (let ((l (org-element-property :label f))) + (when (and l label (string= label l)) + (throw 'exit (eq footnote-reference f))))) + (or data (plist-get info :parse-tree)) info body-first))))) + +(defun org-export-get-footnote-number (footnote info &optional data body-first) + "Return number associated to a footnote. + +FOOTNOTE is either a footnote reference or a footnote definition. +INFO is the plist containing export state. + +Number is unique throughout the whole parse tree, or DATA, when +non-nil. + +By default, as soon as a new footnote reference is encountered, +counting process moves into its definition. However, if +BODY-FIRST is non-nil, this step is delayed until the end of the +process, leading to a different order when footnotes are nested." + (let ((count 0) + (seen) + (label (org-element-property :label footnote))) + (catch 'exit + (org-export--footnote-reference-map + (lambda (f) + (let ((l (org-element-property :label f))) + (cond + ;; Anonymous footnote match: return number. + ((and (not l) (not label) (eq footnote f)) (throw 'exit (1+ count))) + ;; Labels match: return number. + ((and label l (string= label l)) (throw 'exit (1+ count))) + ;; Otherwise store label and increase counter if label + ;; wasn't encountered yet. + ((not l) (cl-incf count)) + ((not (member l seen)) (push l seen) (cl-incf count))))) + (or data (plist-get info :parse-tree)) info body-first)))) + + +;;;; 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 it to be +;; converted to roman numbers. With an optional argument, +;; `org-export-get-headline-number' returns a number to unnumbered +;; headlines (used for internal id). +;; +;; `org-export-low-level-p', `org-export-first-sibling-p' and +;; `org-export-last-sibling-p' are three useful predicates when it +;; comes to fulfill the `:headline-levels' property. +;; +;; `org-export-get-tags', `org-export-get-category' and +;; `org-export-get-node-property' extract useful information from an +;; headline or a parent headline. They all handle inheritance. +;; +;; `org-export-get-alt-title' tries to retrieve an alternative title, +;; as a secondary string, suitable for table of contents. It falls +;; back onto default title. + +(defun org-export-get-relative-level (headline info) + "Return HEADLINE relative level within current parsed tree. +INFO is a plist holding contextual information." + (+ (org-element-property :level headline) + (or (plist-get info :headline-offset) 0))) + +(defun org-export-low-level-p (headline info) + "Non-nil when HEADLINE is considered as low level. + +INFO is a plist used as a communication channel. + +A low level headlines has a relative level greater than +`:headline-levels' property value. + +Return value is the difference between HEADLINE relative level +and the last level being considered as high enough, or nil." + (let ((limit (plist-get info :headline-levels))) + (when (wholenump limit) + (let ((level (org-export-get-relative-level headline info))) + (and (> level limit) (- level limit)))))) + +(defun org-export-get-headline-number (headline info) + "Return numbered HEADLINE numbering as a list of numbers. +INFO is a plist holding contextual information." + (and (org-export-numbered-headline-p headline info) + (cdr (assq 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." + (unless (org-not-nil (org-export-get-node-property :UNNUMBERED headline t)) + (let ((sec-num (plist-get info :section-numbers)) + (level (org-export-get-relative-level headline info))) + (if (wholenump sec-num) (<= level sec-num) sec-num)))) + +(defun org-export-number-to-roman (n) + "Convert integer N into a roman numeral." + (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") + ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL") + ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV") + ( 1 . "I"))) + (res "")) + (if (<= n 0) + (number-to-string n) + (while roman + (if (>= n (caar roman)) + (setq n (- n (caar roman)) + res (concat res (cdar roman))) + (pop roman))) + res))) + +(defun org-export-get-tags (element info &optional tags inherited) + "Return list of tags associated to ELEMENT. + +ELEMENT has either an `headline' or an `inlinetask' type. INFO +is a plist used as a communication channel. + +When non-nil, optional argument TAGS should be a list of strings. +Any tag belonging to this list will also be removed. + +When optional argument INHERITED is non-nil, tags can also be +inherited from parent headlines and FILETAGS keywords." + (cl-remove-if + (lambda (tag) (member tag tags)) + (if (not inherited) (org-element-property :tags element) + ;; Build complete list of inherited tags. + (let ((current-tag-list (org-element-property :tags element))) + (dolist (parent (org-element-lineage element)) + (dolist (tag (org-element-property :tags parent)) + (when (and (memq (org-element-type parent) '(headline inlinetask)) + (not (member tag current-tag-list))) + (push tag current-tag-list)))) + ;; Add FILETAGS keywords and return results. + (org-uniquify (append (plist-get info :filetags) current-tag-list)))))) + +(defun org-export-get-node-property (property datum &optional inherited) + "Return node PROPERTY value for DATUM. + +PROPERTY is an upcase symbol (e.g., `:COOKIE_DATA'). DATUM is an +element or object. + +If optional argument INHERITED is non-nil, the value can be +inherited from a parent headline. + +Return value is a string or nil." + (let ((headline (if (eq (org-element-type datum) 'headline) datum + (org-export-get-parent-headline datum)))) + (if (not inherited) (org-element-property property datum) + (let ((parent headline)) + (catch 'found + (while parent + (when (plist-member (nth 1 parent) property) + (throw 'found (org-element-property property parent))) + (setq parent (org-element-property :parent parent)))))))) + +(defun org-export-get-category (blob info) + "Return category for element or object BLOB. + +INFO is a plist used as a communication channel. + +CATEGORY is automatically inherited from a parent headline, from +#+CATEGORY: keyword or created out of original file name. If all +fail, the fall-back value is \"???\"." + (or (org-export-get-node-property :CATEGORY blob t) + (org-element-map (plist-get info :parse-tree) 'keyword + (lambda (kwd) + (when (equal (org-element-property :key kwd) "CATEGORY") + (org-element-property :value kwd))) + info 'first-match) + (let ((file (plist-get info :input-file))) + (and file (file-name-sans-extension (file-name-nondirectory file)))) + "???")) + +(defun org-export-get-alt-title (headline _) + "Return alternative title for HEADLINE, as a secondary string. +If no optional title is defined, fall-back to the regular title." + (let ((alt (org-element-property :ALT_TITLE headline))) + (if alt (org-element-parse-secondary-string + alt (org-element-restriction 'headline) headline) + (org-element-property :title headline)))) + +(defun org-export-first-sibling-p (blob info) + "Non-nil when BLOB is the first sibling in its parent. +BLOB is an element or an object. If BLOB is a headline, non-nil +means it is the first sibling in the sub-tree. INFO is a plist +used as a communication channel." + (memq (org-element-type (org-export-get-previous-element blob info)) + '(nil section))) + +(defun org-export-last-sibling-p (datum info) + "Non-nil when DATUM is the last sibling in its parent. +DATUM is an element or an object. INFO is a plist used as +a communication channel." + (let ((next (org-export-get-next-element datum info))) + (or (not next) + (and (eq 'headline (org-element-type datum)) + (> (org-element-property :level datum) + (org-element-property :level next)))))) + + +;;;; For Keywords +;; +;; `org-export-get-date' returns a date appropriate for the document +;; to about to be exported. In particular, it takes care of +;; `org-export-date-timestamp-format'. + +(defun org-export-get-date (info &optional fmt) + "Return date value for the current document. + +INFO is a plist used as a communication channel. FMT, when +non-nil, is a time format string that will be applied on the date +if it consists in a single timestamp object. It defaults to +`org-export-date-timestamp-format' when nil. + +A proper date can be a secondary string, a string or nil. It is +meant to be translated with `org-export-data' or alike." + (let ((date (plist-get info :date)) + (fmt (or fmt org-export-date-timestamp-format))) + (cond ((not date) nil) + ((and fmt + (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp)) + (org-timestamp-format (car date) fmt)) + (t date)))) + + +;;;; For Links +;; +;; `org-export-custom-protocol-maybe' handles custom protocol defined +;; in `org-link-parameters'. +;; +;; `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. +;; +;; `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. +;; +;; `org-export-resolve-link' searches for the destination of a link +;; within the parsed tree and returns the element. +;; +;; `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. +;; +;; `org-export-file-uri' expands a filename as stored in :path value +;; of a "file" link into a file URI. +;; +;; Broken links raise a `org-link-broken' error, which is caught by +;; `org-export-data' for further processing, depending on +;; `org-export-with-broken-links' value. + +(org-define-error 'org-link-broken "Unable to resolve link; aborting") + +(defun org-export-custom-protocol-maybe (link desc backend &optional info) + "Try exporting LINK object with a dedicated function. + +DESC is its description, as a string, or nil. BACKEND is the +back-end used for export, as a symbol. + +Return output as a string, or nil if no protocol handles LINK. + +A custom protocol has precedence over regular back-end export. +The function ignores links with an implicit type (e.g., +\"custom-id\")." + (let ((type (org-element-property :type link))) + (unless (or (member type '("coderef" "custom-id" "fuzzy" "radio" nil)) + (not backend)) + (let ((protocol (org-link-get-parameter type :export)) + (path (org-element-property :path link))) + (and (functionp protocol) + (condition-case nil + (funcall protocol path desc backend info) + ;; XXX: The function used (< Org 9.4) to accept only + ;; three mandatory arguments. Type-specific `:export' + ;; functions in the wild may not handle current + ;; signature. Provide backward compatibility support + ;; for them. + (wrong-number-of-arguments + (funcall protocol path desc backend)))))))) + +(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)) + (cl-some (lambda (rule) + (and (string= (org-element-property :type link) (car rule)) + (string-match-p (cdr rule) + (org-element-property :path link)))) + (or rules org-export-default-inline-image-rule))))) + +(defun org-export-insert-image-links (data info &optional rules) + "Insert image links in DATA. + +Org syntax does not support nested links. Nevertheless, some +export back-ends support images as descriptions of links. Since +images are really links to image files, we need to make an +exception about links nesting. + +This function recognizes links whose contents are really images +and turn them into proper nested links. It is meant to be used +as a parse tree filter in back-ends supporting such constructs. + +DATA is a parse tree. INFO is the current state of the export +process, as a plist. + +A description is a valid images if it matches any rule in RULES, +if non-nil, or `org-export-default-inline-image-rule' otherwise. +See `org-export-inline-image-p' for more information about the +structure of RULES. + +Return modified DATA." + (let ((link-re (format "\\`\\(?:%s\\|%s\\)\\'" + org-link-plain-re + org-link-angle-re)) + (case-fold-search t)) + (org-element-map data 'link + (lambda (l) + (let ((contents (org-element-interpret-data (org-element-contents l)))) + (when (and (org-string-nw-p contents) + (string-match link-re contents)) + (let ((type (match-string 1 contents)) + (path (match-string 2 contents))) + (when (cl-some (lambda (rule) + (and (string= type (car rule)) + (string-match-p (cdr rule) path))) + (or rules org-export-default-inline-image-rule)) + ;; Replace contents with image link. + (org-element-adopt-elements + (org-element-set-contents l nil) + (with-temp-buffer + (save-excursion (insert contents)) + (org-element-link-parser)))))))) + info nil nil t)) + data) + +(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. Throw an +error if no block contains REF." + (or (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 (or (org-element-property :label-fmt el) + org-coderef-label-format)) + (ref-re (org-src-coderef-regexp label-fmt ref))) + ;; 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) + (if (org-element-property :use-labels el) ref + (+ (or (org-export-get-loc el info) 0) + (line-number-at-pos))))))) + info 'first-match) + (signal 'org-link-broken (list ref)))) + +(defun org-export-search-cells (datum) + "List search cells for element or object DATUM. + +A search cell follows the pattern (TYPE . SEARCH) where + + TYPE is a symbol among `headline', `custom-id', `target' and + `other'. + + SEARCH is the string a link is expected to match. More + accurately, it is + + - headline's title, as a list of strings, if TYPE is + `headline'. + + - CUSTOM_ID value, as a string, if TYPE is `custom-id'. + + - target's or radio-target's name as a list of strings if + TYPE is `target'. + + - NAME affiliated keyword if TYPE is `other'. + +A search cell is the internal representation of a fuzzy link. It +ignores white spaces and statistics cookies, if applicable." + (pcase (org-element-type datum) + (`headline + (let ((title (split-string + (replace-regexp-in-string + "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" " " + (org-element-property :raw-value datum))))) + (delq nil + (list + (cons 'headline title) + (cons 'other title) + (let ((custom-id (org-element-property :custom-id datum))) + (and custom-id (cons 'custom-id custom-id))))))) + (`target + (list (cons 'target (split-string (org-element-property :value datum))))) + ((and (let name (org-element-property :name datum)) + (guard name)) + (list (cons 'other (split-string name)))) + (_ nil))) + +(defun org-export-string-to-search-cell (s) + "Return search cells associated to string S. +S is either the path of a fuzzy link or a search option, i.e., it +tries to match either a headline (through custom ID or title), +a target or a named element." + (pcase (string-to-char s) + (?* (list (cons 'headline (split-string (substring s 1))))) + (?# (list (cons 'custom-id (substring s 1)))) + ((let search (split-string s)) + (list (cons 'target search) (cons 'other search))))) + +(defun org-export-match-search-cell-p (datum cells) + "Non-nil when DATUM matches search cells CELLS. +DATUM is an element or object. CELLS is a list of search cells, +as returned by `org-export-search-cells'." + (let ((targets (org-export-search-cells datum))) + (and targets (cl-some (lambda (cell) (member cell targets)) cells)))) + +(defun org-export-resolve-fuzzy-link (link info &rest pseudo-types) + "Return LINK destination. + +INFO is a plist holding contextual information. + +Return value can be an object or an element: + +- If LINK path matches a target object (i.e. <<path>>) return it. + +- If LINK path exactly matches the name affiliated keyword + (i.e. #+NAME: path) of an element, return that element. + +- If LINK path exactly matches any headline name, return that + element. + +- Otherwise, throw an error. + +PSEUDO-TYPES are pseudo-elements types, i.e., elements defined +specifically in an export back-end, that could have a name +affiliated keyword. + +Assume LINK type is \"fuzzy\". White spaces are not +significant." + (let* ((search-cells (org-export-string-to-search-cell + (org-element-property :path link))) + (link-cache (or (plist-get info :resolve-fuzzy-link-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :resolve-fuzzy-link-cache table) + table))) + (cached (gethash search-cells link-cache 'not-found))) + (if (not (eq cached 'not-found)) cached + (let ((matches + (org-element-map (plist-get info :parse-tree) + (append pseudo-types '(target) org-element-all-elements) + (lambda (datum) + (and (org-export-match-search-cell-p datum search-cells) + datum))))) + (unless matches + (signal 'org-link-broken (list (org-element-property :path link)))) + (puthash + search-cells + ;; There can be multiple matches for un-typed searches, i.e., + ;; for searches not starting with # or *. In this case, + ;; prioritize targets and names over headline titles. + ;; Matching both a name and a target is not valid, and + ;; therefore undefined. + (or (cl-some (lambda (datum) + (and (not (eq (org-element-type datum) 'headline)) + datum)) + matches) + (car matches)) + link-cache))))) + +(defun org-export-resolve-id-link (link info) + "Return headline referenced as LINK destination. + +INFO is a plist used as a communication channel. + +Return value can be the headline element matched in current parse +tree or a file name. Assume LINK type is either \"id\" or +\"custom-id\". Throw an error if no match is found." + (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 (equal (org-element-property :ID headline) id) + (equal (org-element-property :CUSTOM_ID headline) id)) + headline)) + info 'first-match) + ;; Otherwise, look for external files. + (cdr (assoc id (plist-get info :id-alist))) + (signal 'org-link-broken (list id))))) + +(defun org-export-resolve-radio-link (link info) + "Return radio-target object referenced as LINK destination. + +INFO is a plist used as a communication channel. + +Return value can be a radio-target object or nil. Assume LINK +has type \"radio\"." + (let ((path (replace-regexp-in-string + "[ \r\t\n]+" " " (org-element-property :path link)))) + (org-element-map (plist-get info :parse-tree) 'radio-target + (lambda (radio) + (and (eq (compare-strings + (replace-regexp-in-string + "[ \r\t\n]+" " " (org-element-property :value radio)) + nil nil path nil nil t) + t) + radio)) + info 'first-match))) + +(defun org-export-resolve-link (link info) + "Return LINK destination. + +LINK is a string or a link object. + +INFO is a plist holding contextual information. + +Return value can be an object or an element: + +- If LINK path matches an ID or a custom ID, return the headline. + +- If LINK path matches a fuzzy link, return its destination. + +- Otherwise, throw an error." + ;; Convert string links to link objects. + (when (stringp link) + (setq link (with-temp-buffer + (save-excursion + (insert (org-link-make-string link))) + (org-element-link-parser)))) + (pcase (org-element-property :type link) + ((or "custom-id" "id") (org-export-resolve-id-link link info)) + ("fuzzy" (org-export-resolve-fuzzy-link link info)) + (_ (signal 'org-link-broken (list (org-element-property :path link)))))) + +(defun org-export-file-uri (filename) + "Return file URI associated to FILENAME." + (cond ((string-prefix-p "//" filename) (concat "file:" filename)) + ((not (file-name-absolute-p filename)) filename) + ((file-remote-p filename) (concat "file:/" filename)) + (t + (let ((fullname (expand-file-name filename))) + (concat (if (string-prefix-p "/" fullname) "file://" "file:///") + fullname))))) + +;;;; For References +;; +;; `org-export-get-reference' associate a unique reference for any +;; object or element. It uses `org-export-new-reference' and +;; `org-export-format-reference' to, respectively, generate new +;; internal references and turn them into a string suitable for +;; output. +;; +;; `org-export-get-ordinal' associates a sequence number to any object +;; or element. + +(defun org-export-new-reference (references) + "Return a unique reference, among REFERENCES. +REFERENCES is an alist whose values are in-use references, as +numbers. Returns a number, which is the internal representation +of a reference. See also `org-export-format-reference'." + ;; Generate random 7 digits hexadecimal numbers. Collisions + ;; increase exponentially with the numbers of references. However, + ;; the odds for encountering at least one collision with 1000 active + ;; references in the same document are roughly 0.2%, so this + ;; shouldn't be the bottleneck. + (let ((new (random #x10000000))) + (while (rassq new references) (setq new (random #x10000000))) + new)) + +(defun org-export-format-reference (reference) + "Format REFERENCE into a string. +REFERENCE is a number representing a reference, as returned by +`org-export-new-reference', which see." + (format "org%07x" reference)) + +(defun org-export-get-reference (datum info) + "Return a unique reference for DATUM, as a string. + +DATUM is either an element or an object. INFO is the current +export state, as a plist. + +References for the current document are stored in +`:internal-references' property. Its value is an alist with +associations of the following types: + + (REFERENCE . DATUM) and (SEARCH-CELL . ID) + +REFERENCE is the reference string to be used for object or +element DATUM. SEARCH-CELL is a search cell, as returned by +`org-export-search-cells'. ID is a number or a string uniquely +identifying DATUM within the document. + +This function also checks `:crossrefs' property for search cells +matching DATUM before creating a new reference." + (let ((cache (plist-get info :internal-references))) + (or (car (rassq datum cache)) + (let* ((crossrefs (plist-get info :crossrefs)) + (cells (org-export-search-cells datum)) + ;; Preserve any pre-existing association between + ;; a search cell and a reference, i.e., when some + ;; previously published document referenced a location + ;; within current file (see + ;; `org-publish-resolve-external-link'). + ;; + ;; However, there is no guarantee that search cells are + ;; unique, e.g., there might be duplicate custom ID or + ;; two headings with the same title in the file. + ;; + ;; As a consequence, before re-using any reference to + ;; an element or object, we check that it doesn't refer + ;; to a previous element or object. + (new (or (cl-some + (lambda (cell) + (let ((stored (cdr (assoc cell crossrefs)))) + (when stored + (let ((old (org-export-format-reference stored))) + (and (not (assoc old cache)) stored))))) + cells) + (org-export-new-reference cache))) + (reference-string (org-export-format-reference new))) + ;; Cache contains both data already associated to + ;; a reference and in-use internal references, so as to make + ;; unique references. + (dolist (cell cells) (push (cons cell new) cache)) + ;; Retain a direct association between reference string and + ;; DATUM since (1) not every object or element can be given + ;; a search cell (2) it permits quick lookup. + (push (cons reference-string datum) cache) + (plist-put info :internal-references cache) + reference-string)))) + +(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 counting +only a certain type of object (i.e. inline images). + +Return value is a list of numbers if ELEMENT is a headline or an +item. It is nil for keywords. It represents the footnote number +for footnote definitions and footnote references. If ELEMENT is +a target, return the same value as if ELEMENT was the closest +table, item or headline containing the target. In any other +case, return the sequence number of ELEMENT among elements or +objects of the same type." + ;; Ordinal of a target object refer to the ordinal of the closest + ;; table, item, or headline containing the object. + (when (eq (org-element-type element) 'target) + (setq element + (org-element-lineage + element + '(footnote-definition footnote-reference headline item table)))) + (cl-case (org-element-type element) + ;; Special case 1: A headline returns its number as a list. + (headline (org-export-get-headline-number element info)) + ;; Special case 2: An item returns its number as a list. + (item (let ((struct (org-element-property :structure element))) + (org-list-get-item-number + (org-element-property :begin element) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct)))) + ((footnote-definition footnote-reference) + (org-export-get-footnote-number element info)) + (otherwise + (let ((counter 0)) + ;; Increment counter until ELEMENT is found again. + (org-element-map (plist-get info :parse-tree) + (or types (org-element-type element)) + (lambda (el) + (cond + ((eq element el) (1+ counter)) + ((not predicate) (cl-incf counter) nil) + ((funcall predicate el info) (cl-incf counter) nil))) + info 'first-match))))) + +;;;; For Raw objects +;; +;; `org-export-raw-string' builds a pseudo-object out of a string +;; that any export back-end returns as-is. + +;;;###autoload +(defun org-export-raw-string (s) + "Return a raw object containing string S. +A raw string is exported as-is, with no additional processing +from the export back-end." + (unless (stringp s) (error "Wrong raw contents type: %S" s)) + (org-element-create 'raw nil s)) + +;;;; 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 count of lines of code before ELEMENT. + +ELEMENT is an example-block or src-block element. INFO is the +plist used as a communication channel. + +Count includes every line of code in example-block or src-block +with a \"+n\" or \"-n\" switch before block. Return nil if +ELEMENT doesn't allow line numbering." + (pcase (org-element-property :number-lines element) + (`(new . ,n) n) + (`(continued . ,n) + (let ((loc 0)) + (org-element-map (plist-get info :parse-tree) '(src-block example-block) + (lambda (el) + ;; ELEMENT is reached: Quit loop and return locs. + (if (eq el element) (+ loc n) + ;; Only count lines from src-block and example-block + ;; elements with a "+n" or "-n" switch. + (let ((linum (org-element-property :number-lines el))) + (when linum + (let ((lines (org-count-lines + (org-element-property :value el)))) + ;; Accumulate locs or reset them. + (pcase linum + (`(new . ,n) (setq loc (+ n lines))) + (`(continued . ,n) (cl-incf loc (+ n lines))))))) + nil)) ;Return nil to stay in the loop. + info 'first-match))))) + +(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, protective commas and spurious indentation, and CDR is +an alist between relative line number (integer) and name of code +reference on that line (string)." + (let* ((line 0) refs + (value (org-element-property :value element)) + ;; Remove global indentation from code, if necessary. Also + ;; remove final newline character, since it doesn't belongs + ;; to the code proper. + (code (replace-regexp-in-string + "\n\\'" "" + (if (or org-src-preserve-indentation + (org-element-property :preserve-indent element)) + value + (org-remove-indentation value)))) + ;; Build a regexp matching a loc with a reference. + (ref-re (org-src-coderef-regexp (org-src-coderef-format element)))) + ;; Return value. + (cons + ;; Code with references removed. + (mapconcat + (lambda (loc) + (cl-incf line) + (if (not (string-match ref-re loc)) loc + ;; Ref line: remove ref, and add its position in REFS. + (push (cons line (match-string 3 loc)) refs) + (replace-match "" nil nil loc 1))) + (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 (split-string code "\n")) + (--line 0)) + (concat + (mapconcat + (lambda (--loc) + (cl-incf --line) + (let ((--ref (cdr (assq --line ref-alist)))) + (funcall fun --loc (and num-lines (+ num-lines --line)) --ref))) + --locs "\n") + "\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 (split-string code "\n"))) + (if (null code-lines) "" + (let* ((refs (and (org-element-property :retain-labels element) + (cdr code-info))) + ;; Handle line numbering. + (num-start (org-export-get-loc element info)) + (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))) + ?\s) + (format "(%s)" ref)))))) + num-start refs))))) + + +;;;; For Tables +;; +;; `org-export-table-has-special-column-p' and +;; `org-export-table-row-is-special-p' are predicates used to look for +;; meta-information about the table structure. +;; +;; `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', +;; `org-export-table-row-ends-header-p' and +;; `org-export-table-row-in-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 column + ;; containing only empty cells as special. + (let ((special-column? 'empty)) + (catch 'exit + (dolist (row (org-element-contents table)) + (when (eq (org-element-property :type row) 'standard) + (let ((value (org-element-contents + (car (org-element-contents row))))) + (cond ((member value + '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) + (setq special-column? 'special)) + ((null value)) + (t (throw 'exit nil)))))) + (eq special-column? 'special)))) + +(defun org-export-table-has-header-p (table info) + "Non-nil when TABLE has a header. + +INFO is a plist used as a communication channel. + +A table has a header when it contains at least two row groups." + (let* ((cache (or (plist-get info :table-header-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-header-cache table) + table))) + (cached (gethash table cache 'no-cache))) + (if (not (eq cached 'no-cache)) cached + (let ((rowgroup 1) row-flag) + (puthash table + (org-element-map table 'table-row + (lambda (row) + (cond + ((> rowgroup 1) t) + ((and row-flag + (eq (org-element-property :type row) 'rule)) + (cl-incf rowgroup) + (setq row-flag nil)) + ((and (not row-flag) + (eq (org-element-property :type row) 'standard)) + (setq row-flag t) + nil))) + info 'first-match) + cache))))) + +(defun org-export-table-row-is-special-p (table-row _) + "Non-nil if TABLE-ROW is considered special. +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 + (dolist (cell (org-element-contents table-row)) + (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))))) + (eq special-row-p 'cookie))))))) + +(defun org-export-table-row-group (table-row info) + "Return TABLE-ROW's group number, as an integer. + +INFO is a plist used as the communication channel. + +Return value is the group number, as an integer, or nil for +special rows and rows separators. First group is also table's +header." + (when (eq (org-element-property :type table-row) 'standard) + (let* ((cache (or (plist-get info :table-row-group-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-row-group-cache table) + table))) + (cached (gethash table-row cache 'no-cache))) + (if (not (eq cached 'no-cache)) cached + ;; First time a row is queried, populate cache with all the + ;; rows from the table. + (let ((group 0) row-flag) + (org-element-map (org-export-get-parent table-row) 'table-row + (lambda (row) + (if (eq (org-element-property :type row) 'rule) + (setq row-flag nil) + (unless row-flag (cl-incf group) (setq row-flag t)) + (puthash row group cache))) + info)) + (gethash table-row cache))))) + +(defun org-export-table-cell-width (table-cell info) + "Return TABLE-CELL contents width. + +INFO is a plist used as the communication channel. + +Return value is the width given by the last width cookie in the +same column as TABLE-CELL, or nil." + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent row)) + (cells (org-element-contents row)) + (columns (length cells)) + (column (- columns (length (memq table-cell cells)))) + (cache (or (plist-get info :table-cell-width-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-cell-width-cache table) + table))) + (width-vector (or (gethash table cache) + (puthash table (make-vector columns 'empty) cache)))) + ;; Table rows may not have the same number of cells. Extend + ;; WIDTH-VECTOR appropriately if we encounter a row larger than + ;; expected. + (when (>= column (length width-vector)) + (setq width-vector + (vconcat width-vector + (make-list (- (1+ column) (length width-vector)) + 'empty))) + (puthash table width-vector cache)) + (pcase (aref width-vector column) + (`empty + (catch 'found + (dolist (row (org-element-contents table)) + (when (org-export-table-row-is-special-p row info) + ;; In a special row, try to find a width cookie at + ;; COLUMN. The following checks avoid expanding + ;; unnecessarily the cell with `org-export-data'. + (pcase (org-element-contents + (elt (org-element-contents row) column)) + (`(,(and (pred stringp) cookie)) + (when (string-match "\\`<[lrc]?\\([0-9]+\\)>\\'" cookie) + (let ((w (string-to-number (match-string 1 cookie)))) + (throw 'found (aset width-vector column w)))))))) + (aset width-vector column nil))) + (value value)))) + +(defun org-export-table-cell-alignment (table-cell info) + "Return TABLE-CELL contents alignment. + +INFO is a plist used as the communication channel. + +Return alignment as specified by the last alignment cookie in the +same column as TABLE-CELL. If no such cookie is found, a default +alignment value will be deduced from fraction of numbers in the +column (see `org-table-number-fraction' for more information). +Possible values are `left', `right' and `center'." + ;; Load `org-table-number-fraction' and `org-table-number-regexp'. + (require 'org-table) + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent row)) + (cells (org-element-contents row)) + (columns (length cells)) + (column (- columns (length (memq table-cell cells)))) + (cache (or (plist-get info :table-cell-alignment-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-cell-alignment-cache table) + table))) + (align-vector (or (gethash table cache) + (puthash table (make-vector columns nil) cache)))) + ;; Table rows may not have the same number of cells. Extend + ;; ALIGN-VECTOR appropriately if we encounter a row larger than + ;; expected. + (when (>= column (length align-vector)) + (setq align-vector + (vconcat align-vector + (make-list (- (1+ column) (length align-vector)) + nil))) + (puthash table align-vector cache)) + (or (aref align-vector column) + (let ((number-cells 0) + (total-cells 0) + cookie-align + previous-cell-number-p) + (dolist (row (org-element-contents (org-export-get-parent row))) + (cond + ;; In a special row, try to find an alignment cookie at + ;; COLUMN. + ((org-export-table-row-is-special-p row info) + (let ((value (org-element-contents + (elt (org-element-contents row) column)))) + ;; Since VALUE is a secondary string, the following + ;; checks avoid useless expansion through + ;; `org-export-data'. + (when (and value + (not (cdr value)) + (stringp (car value)) + (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" + (car value)) + (match-string 1 (car value))) + (setq cookie-align (match-string 1 (car value)))))) + ;; Ignore table rules. + ((eq (org-element-property :type row) 'rule)) + ;; In a standard row, check if cell's contents are + ;; expressing some kind of number. Increase NUMBER-CELLS + ;; accordingly. Though, don't bother if an alignment + ;; cookie has already defined cell's alignment. + ((not cookie-align) + (let ((value (org-export-data + (org-element-contents + (elt (org-element-contents row) column)) + info))) + (cl-incf total-cells) + ;; Treat an empty cell as a number if it follows + ;; a number. + (if (not (or (string-match org-table-number-regexp value) + (and (string= value "") previous-cell-number-p))) + (setq previous-cell-number-p nil) + (setq previous-cell-number-p t) + (cl-incf number-cells)))))) + ;; Return value. Alignment specified by cookies has + ;; precedence over alignment deduced from cell's contents. + (aset align-vector + column + (cond ((equal cookie-align "l") 'left) + ((equal cookie-align "r") 'right) + ((equal cookie-align "c") 'center) + ((>= (/ (float number-cells) total-cells) + org-table-number-fraction) + 'right) + (t 'left))))))) + +(defun org-export-table-cell-borders (table-cell info) + "Return TABLE-CELL borders. + +INFO is a plist used as a communication channel. + +Return value is a list of symbols, or nil. Possible values are: +`top', `bottom', `above', `below', `left' and `right'. Note: +`top' (resp. `bottom') only happen for a cell in the first +row (resp. last row) of the table, ignoring table rules, if any. + +Returned borders ignore special rows." + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent-table table-cell)) + borders) + ;; Top/above border? TABLE-CELL has a border above when a rule + ;; used to demarcate row groups can be found above. Hence, + ;; finding a rule isn't sufficient to push `above' in BORDERS: + ;; another regular row has to be found above that rule. + (let (rule-flag) + (catch 'exit + ;; Look at every row before the current one. + (dolist (row (cdr (memq row (reverse (org-element-contents table))))) + (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))))) + ;; 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 + ;; Look at every row after the current one. + (dolist (row (cdr (memq row (org-element-contents table)))) + (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))))) + ;; 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)))))) + ;; Table rows are read in reverse order so last column groups + ;; row has precedence over any previous one. + (dolist (row (reverse (org-element-contents table))) + (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))))))) + ;; 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 column 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 column 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 row 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 row 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-in-header-p (table-row info) + "Non-nil when TABLE-ROW is located within table's header. +INFO is a plist used as a communication channel. Always return +nil for special rows and rows separators." + (and (org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + (eql (org-export-table-row-group table-row info) 1))) + +(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-row-in-header-p table-row info) + (org-export-table-row-starts-rowgroup-p table-row info))) + +(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-row-in-header-p table-row info) + (org-export-table-row-ends-rowgroup-p table-row info))) + +(defun org-export-table-row-number (table-row info) + "Return TABLE-ROW number. +INFO is a plist used as a communication channel. Return value is +zero-indexed and ignores separators. The function returns nil +for special rows and separators." + (when (eq (org-element-property :type table-row) 'standard) + (let* ((cache (or (plist-get info :table-row-number-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-row-number-cache table) + table))) + (cached (gethash table-row cache 'no-cache))) + (if (not (eq cached 'no-cache)) cached + ;; First time a row is queried, populate cache with all the + ;; rows from the table. + (let ((number -1)) + (org-element-map (org-export-get-parent-table table-row) 'table-row + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (puthash row (cl-incf number) cache))) + info)) + (gethash table-row cache))))) + +(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) + (cl-incf rows) + (unless first-row (setq first-row row)))) + info) + ;; Set number of columns. + (org-element-map first-row 'table-cell (lambda (_) (cl-incf columns)) info) + ;; Return value. + (cons rows columns))) + +(defun org-export-table-cell-address (table-cell info) + "Return address of a regular TABLE-CELL object. + +TABLE-CELL is the cell considered. INFO is a plist used as +a communication channel. + +Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are +zero-based index. Only exportable cells are considered. The +function returns nil for other cells." + (let* ((table-row (org-export-get-parent table-cell)) + (row-number (org-export-table-row-number table-row info))) + (when row-number + (cons row-number + (let ((col-count 0)) + (org-element-map table-row 'table-cell + (lambda (cell) + (if (eq cell table-cell) col-count (cl-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 (cl-incf row-count) nil))) + info 'first-match)) + 'table-cell + (lambda (cell) + (if (= column-count column-pos) cell + (cl-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. +;; +;; `org-export-toc-entry-backend' builds a special anonymous back-end +;; useful to export table of contents' entries. + +(defun org-export-collect-headlines (info &optional n scope) + "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. + +Optional argument SCOPE, when non-nil, is an element. If it is +a headline, only children of SCOPE are collected. Otherwise, +collect children of the headline containing provided element. If +there is no such headline, collect all headlines. In any case, +argument N becomes relative to the level of that headline. + +Return a list of all exportable headlines as parsed elements. +Footnote sections are ignored." + (let* ((scope (cond ((not scope) (plist-get info :parse-tree)) + ((eq (org-element-type scope) 'headline) scope) + ((org-export-get-parent-headline scope)) + (t (plist-get info :parse-tree)))) + (limit (plist-get info :headline-levels)) + (n (if (not (wholenump n)) limit + (min (if (eq (org-element-type scope) 'org-data) n + (+ (org-export-get-relative-level scope info) n)) + limit)))) + (org-element-map (org-element-contents scope) 'headline + (lambda (h) + (and (not (org-element-property :footnote-section-p h)) + (not (equal "notoc" + (org-export-get-node-property :UNNUMBERED h t))) + (>= n (org-export-get-relative-level h info)) + h)) + 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 source 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)) + +(defun org-export-excluded-from-toc-p (headline info) + "Non-nil if HEADLINE should be excluded from tables of contents. + +INFO is a plist used as a communication channel. + +Note that such headlines are already excluded from +`org-export-collect-headlines'. Therefore, this function is not +necessary if you only need to list headlines in the table of +contents. However, it is useful if some additional processing is +required on headlines excluded from table of contents." + (or (org-element-property :footnote-section-p headline) + (org-export-low-level-p headline info) + (equal "notoc" (org-export-get-node-property :UNNUMBERED headline t)))) + +(defun org-export-toc-entry-backend (parent &rest transcoders) + "Return an export back-end appropriate for table of contents entries. + +PARENT is an export back-end the returned back-end should inherit +from. + +By default, the back-end removes footnote references and targets. +It also changes links and radio targets into regular text. +TRANSCODERS optional argument, when non-nil, specifies additional +transcoders. A transcoder follows the pattern (TYPE . FUNCTION) +where type is an element or object type and FUNCTION the function +transcoding it." + (declare (indent 1)) + (org-export-create-backend + :parent parent + :transcoders + (append transcoders + `((footnote-reference . ,#'ignore) + (link . ,(lambda (l c i) + (or c + (org-export-data + (org-element-property :raw-link l) + i)))) + (radio-target . ,(lambda (_r c _) c)) + (target . ,#'ignore))))) + + +;;;; Smart Quotes +;; +;; The main function for the smart quotes sub-system is +;; `org-export-activate-smart-quotes', which replaces every quote in +;; a given string from the parse tree with its "smart" counterpart. +;; +;; Dictionary for smart quotes is stored in +;; `org-export-smart-quotes-alist'. + +(defconst org-export-smart-quotes-alist + '(("ar" + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "‹" :html "‹" :latex "\\guilsinglleft{}" + :texinfo "@guilsinglleft{}") + (secondary-closing :utf-8 "›" :html "›" :latex "\\guilsinglright{}" + :texinfo "@guilsinglright{}") + (apostrophe :utf-8 "’" :html "’")) + ("da" + ;; one may use: »...«, "...", ›...‹, or '...'. + ;; https://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ + ;; LaTeX quotes require Babel! + (primary-opening + :utf-8 "»" :html "»" :latex ">>" :texinfo "@guillemetright{}") + (primary-closing + :utf-8 "«" :html "«" :latex "<<" :texinfo "@guillemetleft{}") + (secondary-opening + :utf-8 "›" :html "›" :latex "\\frq{}" :texinfo "@guilsinglright{}") + (secondary-closing + :utf-8 "‹" :html "‹" :latex "\\flq{}" :texinfo "@guilsingleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("de" + (primary-opening + :utf-8 "„" :html "„" :latex "\"`" :texinfo "@quotedblbase{}") + (primary-closing + :utf-8 "“" :html "“" :latex "\"'" :texinfo "@quotedblleft{}") + (secondary-opening + :utf-8 "‚" :html "‚" :latex "\\glq{}" :texinfo "@quotesinglbase{}") + (secondary-closing + :utf-8 "‘" :html "‘" :latex "\\grq{}" :texinfo "@quoteleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("el" + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (secondary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (apostrophe :utf-8 "’" :html "’")) + ("en" + (primary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (primary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("es" + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (secondary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (apostrophe :utf-8 "’" :html "’")) + ("fr" + (primary-opening + :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (primary-closing + :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") + (secondary-opening + :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (secondary-closing :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") + (apostrophe :utf-8 "’" :html "’")) + ("is" + (primary-opening + :utf-8 "„" :html "„" :latex "\"`" :texinfo "@quotedblbase{}") + (primary-closing + :utf-8 "“" :html "“" :latex "\"'" :texinfo "@quotedblleft{}") + (secondary-opening + :utf-8 "‚" :html "‚" :latex "\\glq{}" :texinfo "@quotesinglbase{}") + (secondary-closing + :utf-8 "‘" :html "‘" :latex "\\grq{}" :texinfo "@quoteleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("it" + (primary-opening :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (primary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("no" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nb" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nn" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (secondary-closing :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("ro" + (primary-opening + :utf-8 "„" :html "„" :latex "\"`" :texinfo "@quotedblbase{}") + (primary-closing :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (secondary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (secondary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (apostrophe :utf-8 "’" :html "’")) + ("ru" + ;; https://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5 + ;; https://www.artlebedev.ru/kovodstvo/sections/104/ + (primary-opening :utf-8 "«" :html "«" :latex "{}<<" + :texinfo "@guillemetleft{}") + (primary-closing :utf-8 "»" :html "»" :latex ">>{}" + :texinfo "@guillemetright{}") + (secondary-opening + :utf-8 "„" :html "„" :latex "\\glqq{}" :texinfo "@quotedblbase{}") + (secondary-closing + :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") + (apostrophe :utf-8 "’" :html: "'")) + ("sl" + ;; Based on https://sl.wikipedia.org/wiki/Narekovaj + (primary-opening :utf-8 "«" :html "«" :latex "{}<<" + :texinfo "@guillemetleft{}") + (primary-closing :utf-8 "»" :html "»" :latex ">>{}" + :texinfo "@guillemetright{}") + (secondary-opening + :utf-8 "„" :html "„" :latex "\\glqq{}" :texinfo "@quotedblbase{}") + (secondary-closing + :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("sv" + ;; Based on https://sv.wikipedia.org/wiki/Citattecken + (primary-opening :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (primary-closing :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (secondary-opening :utf-8 "’" :html "’" :latex "’" :texinfo "`") + (secondary-closing :utf-8 "’" :html "’" :latex "’" :texinfo "'") + (apostrophe :utf-8 "’" :html "’"))) + "Smart quotes translations. + +Alist whose CAR is a language string and CDR is an alist with +quote type as key and a plist associating various encodings to +their translation as value. + +A quote type can be any symbol among `primary-opening', +`primary-closing', `secondary-opening', `secondary-closing' and +`apostrophe'. + +Valid encodings include `:utf-8', `:html', `:latex' and +`:texinfo'. + +If no translation is found, the quote character is left as-is.") + +(defun org-export--smart-quote-status (s info) + "Return smart quote status at the beginning of string S. +INFO is the current export state, as a plist." + (let* ((parent (org-element-property :parent s)) + (cache (or (plist-get info :smart-quote-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :smart-quote-cache table) + table))) + (value (gethash parent cache 'missing-data))) + (if (not (eq value 'missing-data)) (cdr (assq s value)) + (let (level1-open full-status) + (org-element-map + (let ((secondary (org-element-secondary-p s))) + (if secondary (org-element-property secondary parent) + (org-element-contents parent))) + 'plain-text + (lambda (text) + (let ((start 0) current-status) + (while (setq start (string-match "['\"]" text start)) + (push + (cond + ((equal (match-string 0 text) "\"") + (setf level1-open (not level1-open)) + (if level1-open 'primary-opening 'primary-closing)) + ;; Not already in a level 1 quote: this is an + ;; apostrophe. + ((not level1-open) 'apostrophe) + ;; Extract previous char and next char. As + ;; a special case, they can also be set to `blank', + ;; `no-blank' or nil. Then determine if current + ;; match is allowed as an opening quote or a closing + ;; quote. + (t + (let* ((previous + (if (> start 0) (substring text (1- start) start) + (let ((p (org-export-get-previous-element + text info))) + (cond ((not p) nil) + ((stringp p) (substring p -1)) + ((memq (org-element-property :post-blank p) + '(0 nil)) + 'no-blank) + (t 'blank))))) + (next + (if (< (1+ start) (length text)) + (substring text (1+ start) (+ start 2)) + (let ((n (org-export-get-next-element text info))) + (cond ((not n) nil) + ((stringp n) (substring n 0 1)) + (t 'no-blank))))) + (allow-open + (and (if (stringp previous) + (string-match "\\s\"\\|\\s-\\|\\s(" + previous) + (memq previous '(blank nil))) + (if (stringp next) + (string-match "\\w\\|\\s.\\|\\s_" next) + (eq next 'no-blank)))) + (allow-close + (and (if (stringp previous) + (string-match "\\w\\|\\s.\\|\\s_" previous) + (eq previous 'no-blank)) + (if (stringp next) + (string-match "\\s-\\|\\s)\\|\\s.\\|\\s\"" + next) + (memq next '(blank nil)))))) + (cond + ((and allow-open allow-close) (error "Should not happen")) + (allow-open 'secondary-opening) + (allow-close 'secondary-closing) + (t 'apostrophe))))) + current-status) + (cl-incf start)) + (when current-status + (push (cons text (nreverse current-status)) full-status)))) + info nil org-element-recursive-objects) + (puthash parent full-status cache) + (cdr (assq s full-status)))))) + +(defun org-export-activate-smart-quotes (s encoding info &optional original) + "Replace regular quotes with \"smart\" quotes in string S. + +ENCODING is a symbol among `:html', `:latex', `:texinfo' and +`:utf-8'. INFO is a plist used as a communication channel. + +The function has to retrieve information about string +surroundings in parse tree. It can only happen with an +unmodified string. Thus, if S has already been through another +process, a non-nil ORIGINAL optional argument will provide that +original string. + +Return the new string." + (let ((quote-status + (copy-sequence (org-export--smart-quote-status (or original s) info)))) + (replace-regexp-in-string + "['\"]" + (lambda (match) + (or (plist-get + (cdr (assq (pop quote-status) + (cdr (assoc (plist-get info :language) + org-export-smart-quotes-alist)))) + encoding) + match)) + s nil t))) + +;;;; Topology +;; +;; Here are various functions to retrieve information about the +;; neighborhood of a given element or object. Neighbors 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'). + +;; defsubst org-export-get-parent must be defined before first use + +(defun org-export-get-parent-headline (blob) + "Return BLOB parent headline or nil. +BLOB is the element or object being considered." + (org-element-lineage blob '(headline))) + +(defun org-export-get-parent-element (object) + "Return first element containing OBJECT or nil. +OBJECT is the object to consider." + (org-element-lineage object org-element-all-elements)) + +(defun org-export-get-parent-table (object) + "Return OBJECT parent table or nil. +OBJECT is either a `table-cell' or `table-element' type object." + (org-element-lineage object '(table))) + +(defun org-export-get-previous-element (blob info &optional n) + "Return previous element or object. + +BLOB is an element or object. INFO is a plist used as +a communication channel. Return previous exportable element or +object, a string, or nil. + +When optional argument N is a positive integer, return a list +containing up to N siblings before BLOB, from farthest to +closest. With any other non-nil value, return a list containing +all of them." + (let* ((secondary (org-element-secondary-p blob)) + (parent (org-export-get-parent blob)) + (siblings + (if secondary (org-element-property secondary parent) + (org-element-contents parent))) + prev) + (catch 'exit + (dolist (obj (cdr (memq blob (reverse siblings))) prev) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj prev)) + ((zerop n) (throw 'exit prev)) + (t (cl-decf n) (push obj prev))))))) + +(defun org-export-get-next-element (blob info &optional n) + "Return next element or object. + +BLOB is an element or object. INFO is a plist used as +a communication channel. Return next exportable element or +object, a string, or nil. + +When optional argument N is a positive integer, return a list +containing up to N siblings after BLOB, from closest to farthest. +With any other non-nil value, return a list containing all of +them." + (let* ((secondary (org-element-secondary-p blob)) + (parent (org-export-get-parent blob)) + (siblings + (cdr (memq blob + (if secondary (org-element-property secondary parent) + (org-element-contents parent))))) + next) + (catch 'exit + (dolist (obj siblings (nreverse next)) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj next)) + ((zerop n) (throw 'exit (nreverse next))) + (t (cl-decf n) (push obj next))))))) + + +;;;; Translation +;; +;; `org-export-translate' translates a string according to the language +;; specified by the LANGUAGE keyword. `org-export-dictionary' contains +;; the dictionary used for the translation. + +(defconst org-export-dictionary + '(("%e %n: %c" + ("fr" :default "%e %n : %c" :html "%e %n : %c")) + ("Author" + ("ar" :default "تأليف") + ("ca" :default "Autor") + ("cs" :default "Autor") + ("da" :default "Forfatter") + ("de" :default "Autor") + ("eo" :html "Aŭtoro") + ("es" :default "Autor") + ("et" :default "Autor") + ("fi" :html "Tekijä") + ("fr" :default "Auteur") + ("hu" :default "Szerzõ") + ("is" :html "Höfundur") + ("it" :default "Autore") + ("ja" :default "著者" :html "著者") + ("nl" :default "Auteur") + ("no" :default "Forfatter") + ("nb" :default "Forfatter") + ("nn" :default "Forfattar") + ("pl" :default "Autor") + ("pt_BR" :default "Autor") + ("ro" :default "Autor") + ("ru" :html "Автор" :utf-8 "Автор") + ("sl" :default "Avtor") + ("sv" :html "Författare") + ("tr" :default "Yazar") + ("uk" :html "Автор" :utf-8 "Автор") + ("zh-CN" :html "作者" :utf-8 "作者") + ("zh-TW" :html "作者" :utf-8 "作者")) + ("Continued from previous page" + ("ar" :default "تتمة الصفحة السابقة") + ("cs" :default "Pokračování z předchozí strany") + ("de" :default "Fortsetzung von vorheriger Seite") + ("es" :html "Continúa de la página anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior") + ("fr" :default "Suite de la page précédente") + ("it" :default "Continua da pagina precedente") + ("ja" :default "前ページからの続き") + ("nl" :default "Vervolg van vorige pagina") + ("pl" :default "Ciąg dalszy poprzedniej strony") + ("pt" :default "Continuação da página anterior") + ("pt_BR" :html "Continuação da página anterior" :ascii "Continuacao da pagina anterior" :default "Continuação da página anterior") + ("ro" :default "Continuare de pe pagina precedentă") + ("ru" :html "(Продолжение)" + :utf-8 "(Продолжение)") + ("sl" :default "Nadaljevanje s prejšnje strani") + ("tr" :default "Önceki sayfadan devam ediyor")) + ("Continued on next page" + ("ar" :default "التتمة في الصفحة التالية") + ("cs" :default "Pokračuje na další stránce") + ("de" :default "Fortsetzung nächste Seite") + ("es" :html "Continúa en la siguiente página" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página") + ("fr" :default "Suite page suivante") + ("it" :default "Continua alla pagina successiva") + ("ja" :default "次ページに続く") + ("nl" :default "Vervolg op volgende pagina") + ("pl" :default "Kontynuacja na następnej stronie") + ("pt" :default "Continua na página seguinte") + ("pt_BR" :html "Continua na próxima página" :ascii "Continua na proxima pagina" :default "Continua na próxima página") + ("ro" :default "Continuare pe pagina următoare") + ("ru" :html "(Продолжение следует)" + :utf-8 "(Продолжение следует)") + ("sl" :default "Nadaljevanje na naslednji strani") + ("tr" :default "Devamı sonraki sayfada")) + ("Created" + ("cs" :default "Vytvořeno") + ("nl" :default "Gemaakt op") ;; must be followed by a date or date+time + ("pt_BR" :default "Criado em") + ("ro" :default "Creat") + ("sl" :default "Ustvarjeno") + ("tr" :default "Oluşturuldu")) + ("Date" + ("ar" :default "بتاريخ") + ("ca" :default "Data") + ("cs" :default "Datum") + ("da" :default "Dato") + ("de" :default "Datum") + ("eo" :default "Dato") + ("es" :default "Fecha") + ("et" :html "Kuupäev" :utf-8 "Kuupäev") + ("fi" :html "Päivämäärä") + ("hu" :html "Dátum") + ("is" :default "Dagsetning") + ("it" :default "Data") + ("ja" :default "日付" :html "日付") + ("nl" :default "Datum") + ("no" :default "Dato") + ("nb" :default "Dato") + ("nn" :default "Dato") + ("pl" :default "Data") + ("ro" :default "Data") + ("pt_BR" :default "Data") + ("ru" :html "Дата" :utf-8 "Дата") + ("sl" :default "Datum") + ("sv" :default "Datum") + ("tr" :default "Tarih") + ("uk" :html "Дата" :utf-8 "Дата") + ("zh-CN" :html "日期" :utf-8 "日期") + ("zh-TW" :html "日期" :utf-8 "日期")) + ("Equation" + ("ar" :default "معادلة") + ("cs" :default "Rovnice") + ("da" :default "Ligning") + ("de" :default "Gleichung") + ("es" :ascii "Ecuacion" :html "Ecuación" :default "Ecuación") + ("et" :html "Võrrand" :utf-8 "Võrrand") + ("fr" :ascii "Equation" :default "Équation") + ("is" :default "Jafna") + ("ja" :default "方程式") + ("nl" :default "Vergelijking") + ("no" :default "Ligning") + ("nb" :default "Ligning") + ("nn" :default "Likning") + ("pt_BR" :html "Equação" :default "Equação" :ascii "Equacao") + ("ro" :default "Ecuația") + ("ru" :html "Уравнение" + :utf-8 "Уравнение") + ("sl" :default "Enačba") + ("sv" :default "Ekvation") + ("tr" :default "Eşitlik") + ("zh-CN" :html "方程" :utf-8 "方程")) + ("Figure" + ("ar" :default "شكل") + ("cs" :default "Obrázek") + ("da" :default "Figur") + ("de" :default "Abbildung") + ("es" :default "Figura") + ("et" :default "Joonis") + ("is" :default "Mynd") + ("it" :default "Figura") + ("ja" :default "図" :html "図") + ("nl" :default "Figuur") + ("no" :default "Illustrasjon") + ("nb" :default "Illustrasjon") + ("nn" :default "Illustrasjon") + ("pt_BR" :default "Figura") + ("ro" :default "Imaginea") + ("ru" :html "Рисунок" :utf-8 "Рисунок") + ("sv" :default "Illustration") + ("tr" :default "Şekil") + ("zh-CN" :html "图" :utf-8 "图")) + ("Figure %d:" + ("ar" :default "شكل %d:") + ("cs" :default "Obrázek %d:") + ("da" :default "Figur %d") + ("de" :default "Abbildung %d:") + ("es" :default "Figura %d:") + ("et" :default "Joonis %d:") + ("fr" :default "Figure %d :" :html "Figure %d :") + ("is" :default "Mynd %d") + ("it" :default "Figura %d:") + ("ja" :default "図%d: " :html "図%d: ") + ("nl" :default "Figuur %d:" :html "Figuur %d:") + ("no" :default "Illustrasjon %d") + ("nb" :default "Illustrasjon %d") + ("nn" :default "Illustrasjon %d") + ("pt_BR" :default "Figura %d:") + ("ro" :default "Imaginea %d:") + ("ru" :html "Рис. %d.:" :utf-8 "Рис. %d.:") + ("sl" :default "Slika %d") + ("sv" :default "Illustration %d") + ("tr" :default "Şekil %d:") + ("zh-CN" :html "图%d " :utf-8 "图%d ")) + ("Footnotes" + ("ar" :default "الهوامش") + ("ca" :html "Peus de pàgina") + ("cs" :default "Poznámky pod čarou") + ("da" :default "Fodnoter") + ("de" :html "Fußnoten" :default "Fußnoten") + ("eo" :default "Piednotoj") + ("es" :ascii "Notas al pie de pagina" :html "Notas al pie de página" :default "Notas al pie de página") + ("et" :html "Allmärkused" :utf-8 "Allmärkused") + ("fi" :default "Alaviitteet") + ("fr" :default "Notes de bas de page") + ("hu" :html "Lábjegyzet") + ("is" :html "Aftanmálsgreinar") + ("it" :html "Note a piè di pagina") + ("ja" :default "脚注" :html "脚注") + ("nl" :default "Voetnoten") + ("no" :default "Fotnoter") + ("nb" :default "Fotnoter") + ("nn" :default "Fotnotar") + ("pl" :default "Przypis") + ("pt_BR" :html "Notas de Rodapé" :default "Notas de Rodapé" :ascii "Notas de Rodape") + ("ro" :default "Note de subsol") + ("ru" :html "Сноски" :utf-8 "Сноски") + ("sl" :default "Opombe") + ("sv" :default "Fotnoter") + ("tr" :default "Dipnotlar") + ("uk" :html "Примітки" + :utf-8 "Примітки") + ("zh-CN" :html "脚注" :utf-8 "脚注") + ("zh-TW" :html "腳註" :utf-8 "腳註")) + ("List of Listings" + ("ar" :default "قائمة بالبرامج") + ("cs" :default "Seznam programů") + ("da" :default "Programmer") + ("de" :default "Programmauflistungsverzeichnis") + ("es" :ascii "Indice de Listados de programas" :html "Índice de Listados de programas" :default "Índice de Listados de programas") + ("et" :default "Loendite nimekiri") + ("fr" :default "Liste des programmes") + ("ja" :default "ソースコード目次") + ("nl" :default "Lijst van programma's") + ("no" :default "Dataprogrammer") + ("nb" :default "Dataprogrammer") + ("pt_BR" :html "Índice de Listagens" :default "Índice de Listagens" :ascii "Indice de Listagens") + ("ru" :html "Список распечаток" + :utf-8 "Список распечаток") + ("sl" :default "Seznam programskih izpisov") + ("tr" :default "Program Listesi") + ("zh-CN" :html "代码目录" :utf-8 "代码目录")) + ("List of Tables" + ("ar" :default "قائمة بالجداول") + ("cs" :default "Seznam tabulek") + ("da" :default "Tabeller") + ("de" :default "Tabellenverzeichnis") + ("es" :ascii "Indice de tablas" :html "Índice de tablas" :default "Índice de tablas") + ("et" :default "Tabelite nimekiri") + ("fr" :default "Liste des tableaux") + ("is" :default "Töfluskrá" :html "Töfluskrá") + ("it" :default "Indice delle tabelle") + ("ja" :default "表目次") + ("nl" :default "Lijst van tabellen") + ("no" :default "Tabeller") + ("nb" :default "Tabeller") + ("nn" :default "Tabeller") + ("pt_BR" :html "Índice de Tabelas" :default "Índice de Tabelas" :ascii "Indice de Tabelas") + ("ro" :default "Tabele") + ("ru" :html "Список таблиц" + :utf-8 "Список таблиц") + ("sl" :default "Seznam tabel") + ("sv" :default "Tabeller") + ("tr" :default "Tablo Listesi") + ("zh-CN" :html "表格目录" :utf-8 "表格目录")) + ("Listing" + ("ar" :default "برنامج") + ("cs" :default "Program") + ("da" :default "Program") + ("de" :default "Programmlisting") + ("es" :default "Listado de programa") + ("et" :default "Loend") + ("fr" :default "Programme" :html "Programme") + ("it" :default "Listato") + ("ja" :default "ソースコード") + ("nl" :default "Programma") + ("no" :default "Dataprogram") + ("nb" :default "Dataprogram") + ("pt_BR" :default "Listagem") + ("ro" :default "Lista") + ("ru" :html "Распечатка" + :utf-8 "Распечатка") + ("sl" :default "Izpis programa") + ("tr" :default "Program") + ("zh-CN" :html "代码" :utf-8 "代码")) + ("Listing %d:" + ("ar" :default "برنامج %d:") + ("cs" :default "Program %d:") + ("da" :default "Program %d") + ("de" :default "Programmlisting %d") + ("es" :default "Listado de programa %d") + ("et" :default "Loend %d") + ("fr" :default "Programme %d :" :html "Programme %d :") + ("it" :default "Listato %d :") + ("ja" :default "ソースコード%d:") + ("nl" :default "Programma %d:" :html "Programma %d:") + ("no" :default "Dataprogram %d") + ("nb" :default "Dataprogram %d") + ("ro" :default "Lista %d") + ("pt_BR" :default "Listagem %d:") + ("ru" :html "Распечатка %d.:" + :utf-8 "Распечатка %d.:") + ("sl" :default "Izpis programa %d") + ("tr" :default "Program %d:") + ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) + ("References" + ("ar" :default "المراجع") + ("cs" :default "Reference") + ("de" :default "Quellen") + ("es" :default "Referencias") + ("fr" :ascii "References" :default "Références") + ("it" :default "Riferimenti") + ("nl" :default "Bronverwijzingen") + ("pt_BR" :html "Referências" :default "Referências" :ascii "Referencias") + ("ro" :default "Bibliografie") + ("sl" :default "Reference") + ("tr" :default "Referanslar")) + ("See figure %s" + ("cs" :default "Viz obrázek %s") + ("fr" :default "cf. figure %s" + :html "cf. figure %s" :latex "cf.~figure~%s") + ("it" :default "Vedi figura %s") + ("nl" :default "Zie figuur %s" + :html "Zie figuur %s" :latex "Zie figuur~%s") + ("pt_BR" :default "Veja a figura %s") + ("ro" :default "Vezi figura %s") + ("sl" :default "Glej sliko %s") + ("tr" :default "bkz. şekil %s")) + ("See listing %s" + ("cs" :default "Viz program %s") + ("fr" :default "cf. programme %s" + :html "cf. programme %s" :latex "cf.~programme~%s") + ("nl" :default "Zie programma %s" + :html "Zie programma %s" :latex "Zie programma~%s") + ("pt_BR" :default "Veja a listagem %s") + ("ro" :default "Vezi tabelul %s") + ("sl" :default "Glej izpis programa %s") + ("tr" :default "bkz. program %s")) + ("See section %s" + ("ar" :default "انظر قسم %s") + ("cs" :default "Viz sekce %s") + ("da" :default "jævnfør afsnit %s") + ("de" :default "siehe Abschnitt %s") + ("es" :ascii "Vea seccion %s" :html "Vea sección %s" :default "Vea sección %s") + ("et" :html "Vaata peatükki %s" :utf-8 "Vaata peatükki %s") + ("fr" :default "cf. section %s") + ("it" :default "Vedi sezione %s") + ("ja" :default "セクション %s を参照") + ("nl" :default "Zie sectie %s" + :html "Zie sectie %s" :latex "Zie sectie~%s") + ("pt_BR" :html "Veja a seção %s" :default "Veja a seção %s" + :ascii "Veja a secao %s") + ("ro" :default "Vezi secțiunea %s") + ("ru" :html "См. раздел %s" + :utf-8 "См. раздел %s") + ("sl" :default "Glej poglavje %d") + ("tr" :default "bkz. bölüm %s") + ("zh-CN" :html "参见第%s节" :utf-8 "参见第%s节")) + ("See table %s" + ("cs" :default "Viz tabulka %s") + ("fr" :default "cf. tableau %s" + :html "cf. tableau %s" :latex "cf.~tableau~%s") + ("it" :default "Vedi tabella %s") + ("nl" :default "Zie tabel %s" + :html "Zie tabel %s" :latex "Zie tabel~%s") + ("pt_BR" :default "Veja a tabela %s") + ("ro" :default "Vezi tabelul %s") + ("sl" :default "Glej tabelo %s") + ("tr" :default "bkz. tablo %s")) + ("Table" + ("ar" :default "جدول") + ("cs" :default "Tabulka") + ("de" :default "Tabelle") + ("es" :default "Tabla") + ("et" :default "Tabel") + ("fr" :default "Tableau") + ("is" :default "Tafla") + ("it" :default "Tabella") + ("ja" :default "表" :html "表") + ("nl" :default "Tabel") + ("pt_BR" :default "Tabela") + ("ro" :default "Tabel") + ("ru" :html "Таблица" + :utf-8 "Таблица") + ("tr" :default "Tablo") + ("zh-CN" :html "表" :utf-8 "表")) + ("Table %d:" + ("ar" :default "جدول %d:") + ("cs" :default "Tabulka %d:") + ("da" :default "Tabel %d") + ("de" :default "Tabelle %d") + ("es" :default "Tabla %d") + ("et" :default "Tabel %d") + ("fr" :default "Tableau %d :") + ("is" :default "Tafla %d") + ("it" :default "Tabella %d:") + ("ja" :default "表%d:" :html "表%d:") + ("nl" :default "Tabel %d:" :html "Tabel %d:") + ("no" :default "Tabell %d") + ("nb" :default "Tabell %d") + ("nn" :default "Tabell %d") + ("pt_BR" :default "Tabela %d:") + ("ro" :default "Tabel %d") + ("ru" :html "Таблица %d.:" + :utf-8 "Таблица %d.:") + ("sl" :default "Tabela %d") + ("sv" :default "Tabell %d") + ("tr" :default "Tablo %d") + ("zh-CN" :html "表%d " :utf-8 "表%d ")) + ("Table of Contents" + ("ar" :default "قائمة المحتويات") + ("ca" :html "Índex") + ("cs" :default "Obsah") + ("da" :default "Indhold") + ("de" :default "Inhaltsverzeichnis") + ("eo" :default "Enhavo") + ("es" :ascii "Indice" :html "Índice" :default "Índice") + ("et" :default "Sisukord") + ("fi" :html "Sisällysluettelo") + ("fr" :ascii "Sommaire" :default "Table des matières") + ("hu" :html "Tartalomjegyzék") + ("is" :default "Efnisyfirlit") + ("it" :default "Indice") + ("ja" :default "目次" :html "目次") + ("nl" :default "Inhoudsopgave") + ("no" :default "Innhold") + ("nb" :default "Innhold") + ("nn" :default "Innhald") + ("pl" :html "Spis treści") + ("pt_BR" :html "Índice" :utf8 "Índice" :ascii "Indice") + ("ro" :default "Cuprins") + ("ru" :html "Содержание" + :utf-8 "Содержание") + ("sl" :default "Kazalo") + ("sv" :html "Innehåll") + ("tr" :default "İçindekiler") + ("uk" :html "Зміст" :utf-8 "Зміст") + ("zh-CN" :html "目录" :utf-8 "目录") + ("zh-TW" :html "目錄" :utf-8 "目錄")) + ("Unknown reference" + ("ar" :default "مرجع غير معرّف") + ("da" :default "ukendt reference") + ("de" :default "Unbekannter Verweis") + ("es" :default "Referencia desconocida") + ("et" :default "Tundmatu viide") + ("fr" :ascii "Destination inconnue" :default "Référence inconnue") + ("it" :default "Riferimento sconosciuto") + ("ja" :default "不明な参照先") + ("nl" :default "Onbekende verwijzing") + ("pt_BR" :html "Referência desconhecida" :default "Referência desconhecida" :ascii "Referencia desconhecida") + ("ro" :default "Referință necunoscută") + ("ru" :html "Неизвестная ссылка" + :utf-8 "Неизвестная ссылка") + ("sl" :default "Neznana referenca") + ("tr" :default "Bilinmeyen referans") + ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) + "Dictionary for export engine. + +Alist whose car is the string to translate and cdr is an alist +whose car is the language string and cdr is a plist whose +properties are possible charsets and values translated terms. + +It is used as a database for `org-export-translate'. Since this +function returns the string as-is if no translation was found, +the variable only needs to record values different from the +entry.") + +(defun org-export-translate (s encoding info) + "Translate string S according to language specification. + +ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1' +and `:utf-8'. INFO is a plist used as a communication channel. + +Translation depends on `:language' property. Return the +translated string. If no translation is found, try to fall back +to `:default' encoding. If it fails, return S." + (let* ((lang (plist-get info :language)) + (translations (cdr (assoc lang + (cdr (assoc s org-export-dictionary)))))) + (or (plist-get translations encoding) + (plist-get translations :default) + s))) + + + +;;; Asynchronous Export +;; +;; `org-export-async-start' is the entry point for asynchronous +;; export. It recreates current buffer (including visibility, +;; narrowing and visited file) in an external Emacs process, and +;; evaluates a command there. It then applies a function on the +;; returned results in the current process. +;; +;; At a higher level, `org-export-to-buffer' and `org-export-to-file' +;; allow exporting to a buffer or a file, asynchronously or not. +;; +;; `org-export-output-file-name' is an auxiliary function meant to be +;; used with `org-export-to-file'. With a given extension, it tries +;; to provide a canonical file name to write export output to. +;; +;; Asynchronously generated results are never displayed directly. +;; Instead, they are stored in `org-export-stack-contents'. They can +;; then be retrieved by calling `org-export-stack'. +;; +;; Export Stack is viewed through a dedicated major mode +;;`org-export-stack-mode' and tools: `org-export-stack-refresh', +;;`org-export-stack-delete', `org-export-stack-view' and +;;`org-export-stack-clear'. +;; +;; For back-ends, `org-export-add-to-stack' add a new source to stack. +;; It should be used whenever `org-export-async-start' is called. + +(defun org-export-async-start (fun body) + "Call function FUN on the results returned by BODY evaluation. + +FUN is an anonymous function of one argument. BODY should be a valid +ELisp source expression. BODY evaluation happens in an asynchronous process, +from a buffer which is an exact copy of the current one. + +Use `org-export-add-to-stack' in FUN in order to register results +in the stack. + +This is a low level function. See also `org-export-to-buffer' +and `org-export-to-file' for more specialized functions." + (declare (indent 1)) + ;; Write the full sexp evaluating BODY in a copy of the current + ;; buffer to a temporary file, as it may be too long for program + ;; args in `start-process'. + (with-temp-message "Initializing asynchronous export process" + (let ((copy-fun (org-export--generate-copy-script (current-buffer))) + (temp-file (make-temp-file "org-export-process"))) + (let ((coding-system-for-write 'utf-8-emacs-unix)) + (write-region + ;; Null characters (from variable values) are inserted + ;; within the file. As a consequence, coding system for + ;; buffer contents could fail to be recognized properly. + (format ";; -*- coding: utf-8-emacs-unix; lexical-binding:t -*-\n%S" + `(with-temp-buffer + ,(when org-export-async-debug '(setq debug-on-error t)) + ;; Ignore `kill-emacs-hook' and code evaluation + ;; queries from Babel as we need a truly + ;; non-interactive process. + (setq kill-emacs-hook nil + org-babel-confirm-evaluate-answer-no t) + ;; Initialize export framework. + (require 'ox) + ;; Re-create current buffer there. + (funcall ',copy-fun) + (restore-buffer-modified-p nil) + ;; Sexp to evaluate in the buffer. + (print ,body))) + nil temp-file nil 'silent)) + ;; Start external process. + (let* ((process-connection-type nil) + (proc-buffer (generate-new-buffer-name "*Org Export Process*")) + (process + (apply + #'start-process + (append + (list "org-export-process" + proc-buffer + (expand-file-name invocation-name invocation-directory) + "--batch") + (if org-export-async-init-file + (list "-Q" "-l" org-export-async-init-file) + (list "-l" user-init-file)) + (list "-l" temp-file))))) + ;; Register running process in stack. + (org-export-add-to-stack (get-buffer proc-buffer) nil process) + ;; Set-up sentinel in order to catch results. + (let ((handler fun)) + (set-process-sentinel + process + (lambda (p _status) + (let ((proc-buffer (process-buffer p))) + (when (eq (process-status p) 'exit) + (unwind-protect + (if (zerop (process-exit-status p)) + (unwind-protect + (let ((results + (with-current-buffer proc-buffer + (goto-char (point-max)) + (backward-sexp) + (read (current-buffer))))) + (funcall handler results)) + (unless org-export-async-debug + (and (get-buffer proc-buffer) + (kill-buffer proc-buffer)))) + (org-export-add-to-stack proc-buffer nil p) + (ding) + (message "Process `%s' exited abnormally" p)) + (unless org-export-async-debug + (delete-file temp-file)))))))))))) + +;;;###autoload +(defun org-export-to-buffer + (backend buffer + &optional async subtreep visible-only body-only ext-plist + post-process) + "Call `org-export-as' with output to a specified buffer. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +BUFFER is the name of the output buffer. If it already exists, +it will be erased first, otherwise, it will be created. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should then be accessible +through the `org-export-stack' interface. When ASYNC is nil, the +buffer is displayed if `org-export-show-temporary-export-buffer' +is non-nil. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is a function which should accept +no argument. It is always called within the current process, +from BUFFER, with point at its beginning. Export back-ends can +use it to set a major mode there, e.g, + + (defun org-latex-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) + (interactive) + (org-export-to-buffer \\='latex \"*Org LATEX Export*\" + async subtreep visible-only body-only ext-plist + #'LaTeX-mode)) + +When expressed as an anonymous function, using `lambda', +POST-PROCESS needs to be quoted. + +This function returns BUFFER." + (declare (indent 2)) + (if async + (org-export-async-start + (let ((cs buffer-file-coding-system)) + (lambda (output) + (with-current-buffer (get-buffer-create buffer) + (erase-buffer) + (setq buffer-file-coding-system cs) + (insert output) + (goto-char (point-min)) + (org-export-add-to-stack (current-buffer) backend) + (ignore-errors (funcall post-process))))) + `(org-export-as + ',backend ,subtreep ,visible-only ,body-only ',ext-plist)) + (let ((output + (org-export-as backend subtreep visible-only body-only ext-plist)) + (buffer (get-buffer-create buffer)) + (encoding buffer-file-coding-system)) + (when (and (org-string-nw-p output) (org-export--copy-to-kill-ring-p)) + (org-kill-new output)) + (with-current-buffer buffer + (erase-buffer) + (setq buffer-file-coding-system encoding) + (insert output) + (goto-char (point-min)) + (and (functionp post-process) (funcall post-process))) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window buffer)) + buffer))) + +;;;###autoload +(defun org-export-to-file + (backend file &optional async subtreep visible-only body-only ext-plist + post-process) + "Call `org-export-as' with output to a specified file. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. FILE is the name of the output file, as +a string. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer will then be accessible +through the `org-export-stack' interface. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is called with FILE as its +argument and happens asynchronously when ASYNC is non-nil. It +has to return a file name, or nil. Export back-ends can use this +to send the output file through additional processing, e.g, + + (defun org-latex-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) + (interactive) + (let ((outfile (org-export-output-file-name \".tex\" subtreep))) + (org-export-to-file \\='latex outfile + async subtreep visible-only body-only ext-plist + #'org-latex-compile))) + +When expressed as an anonymous function, using `lambda', +POST-PROCESS needs to be quoted. + +The function returns either a file name returned by POST-PROCESS, +or FILE." + (declare (indent 2)) + (if (not (file-writable-p file)) (error "Output file not writable") + (let ((ext-plist (org-combine-plists `(:output-file ,file) ext-plist)) + (encoding (or org-export-coding-system buffer-file-coding-system)) + auto-mode-alist) + (if async + (org-export-async-start + (lambda (file) + (org-export-add-to-stack (expand-file-name file) backend)) + `(let ((output + (org-export-as + ',backend ,subtreep ,visible-only ,body-only + ',ext-plist))) + (with-temp-buffer + (insert output) + (let ((coding-system-for-write ',encoding)) + (write-file ,file))) + (or (ignore-errors (funcall ',post-process ,file)) ,file))) + (let ((output (org-export-as + backend subtreep visible-only body-only ext-plist))) + (with-temp-buffer + (insert output) + (let ((coding-system-for-write encoding)) + (write-file file))) + (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output)) + (org-kill-new output)) + ;; Get proper return value. + (or (and (functionp post-process) (funcall post-process file)) + file)))))) + +(defun org-export-output-file-name (extension &optional subtreep pub-dir) + "Return output file's name according to buffer specifications. + +EXTENSION is a string representing the output file extension, +with the leading dot. + +With a non-nil optional argument SUBTREEP, try to determine +output file's name by looking for \"EXPORT_FILE_NAME\" property +of subtree at point. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +Return file name as a string." + (let* ((visited-file (buffer-file-name (buffer-base-buffer))) + (base-name + (concat + (file-name-sans-extension + (or + ;; Check EXPORT_FILE_NAME subtree property. + (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective)) + ;; Check #+EXPORT_FILE_NAME keyword. + (org-with-point-at (point-min) + (catch :found + (let ((case-fold-search t)) + (while (re-search-forward + "^[ \t]*#\\+EXPORT_FILE_NAME:[ \t]+\\S-" nil t) + (let ((element (org-element-at-point))) + (when (eq 'keyword (org-element-type element)) + (throw :found + (org-element-property :value element)))))))) + ;; Extract from buffer's associated file, if any. + (and visited-file + (file-name-nondirectory + ;; For a .gpg visited file, remove the .gpg extension: + (replace-regexp-in-string "\\.gpg\\'" "" visited-file))) + ;; Can't determine file name on our own: ask user. + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (n) (string= extension (file-name-extension n t)))))) + extension)) + (output-file + ;; Build file name. Enforce EXTENSION over whatever user + ;; may have come up with. PUB-DIR, if defined, always has + ;; precedence over any provided path. + (cond + (pub-dir (concat (file-name-as-directory pub-dir) + (file-name-nondirectory base-name))) + ((file-name-absolute-p base-name) base-name) + (t base-name)))) + ;; If writing to OUTPUT-FILE would overwrite original file, append + ;; EXTENSION another time to final name. + (if (and visited-file (file-equal-p visited-file output-file)) + (concat output-file extension) + output-file))) + +(defun org-export-add-to-stack (source backend &optional process) + "Add a new result to export stack if not present already. + +SOURCE is a buffer or a file name containing export results. +BACKEND is a symbol representing export back-end used to generate +it. + +Entries already pointing to SOURCE and unavailable entries are +removed beforehand. Return the new stack." + (setq org-export-stack-contents + (cons (list source backend (or process (current-time))) + (org-export-stack-remove source)))) + +(defun org-export-stack () + "Menu for asynchronous export results and running processes." + (interactive) + (let ((buffer (get-buffer-create "*Org Export Stack*"))) + (with-current-buffer buffer + (org-export-stack-mode) + (tabulated-list-print t)) + (pop-to-buffer buffer)) + (message "Type \"q\" to quit, \"?\" for help")) + +(defun org-export-stack-clear () + "Remove all entries from export stack." + (interactive) + (setq org-export-stack-contents nil)) + +(defun org-export-stack-refresh () + "Refresh the export stack." + (interactive) + (tabulated-list-print t)) + +(defun org-export-stack-remove (&optional source) + "Remove export results at point from stack. +If optional argument SOURCE is non-nil, remove it instead." + (interactive) + (let ((source (or source (org-export--stack-source-at-point)))) + (setq org-export-stack-contents + (cl-remove-if (lambda (el) (equal (car el) source)) + org-export-stack-contents)))) + +(defun org-export-stack-view (&optional in-emacs) + "View export results at point in stack. +With an optional prefix argument IN-EMACS, force viewing files +within Emacs." + (interactive "P") + (let ((source (org-export--stack-source-at-point))) + (cond ((processp source) + (org-switch-to-buffer-other-window (process-buffer source))) + ((bufferp source) (org-switch-to-buffer-other-window source)) + (t (org-open-file source in-emacs))))) + +(defvar org-export-stack-mode-map + (let ((km (make-sparse-keymap))) + (set-keymap-parent km tabulated-list-mode-map) + (define-key km " " #'next-line) + (define-key km "\C-n" #'next-line) + (define-key km [down] #'next-line) + (define-key km "\C-p" #'previous-line) + (define-key km "\C-?" #'previous-line) + (define-key km [up] #'previous-line) + (define-key km "C" #'org-export-stack-clear) + (define-key km "v" #'org-export-stack-view) + (define-key km (kbd "RET") #'org-export-stack-view) + (define-key km "d" #'org-export-stack-remove) + km) + "Keymap for Org Export Stack.") + +(define-derived-mode org-export-stack-mode tabulated-list-mode "Org-Stack" + "Mode for displaying asynchronous export stack. + +Type `\\[org-export-stack]' to visualize the asynchronous export +stack. + +In an Org Export Stack buffer, use \ +\\<org-export-stack-mode-map>`\\[org-export-stack-view]' to view export output +on current line, `\\[org-export-stack-remove]' to remove it from the stack and \ +`\\[org-export-stack-clear]' to clear +stack completely. + +Removing entries in a stack buffer does not affect files +or buffers, only display. + +\\{org-export-stack-mode-map}" + (setq tabulated-list-format + (vector (list "#" 4 #'org-export--stack-num-predicate) + (list "Back-End" 12 t) + (list "Age" 6 nil) + (list "Source" 0 nil))) + (setq tabulated-list-sort-key (cons "#" nil)) + (setq tabulated-list-entries #'org-export--stack-generate) + (add-hook 'tabulated-list-revert-hook #'org-export--stack-generate nil t) + (add-hook 'post-command-hook #'org-export-stack-refresh nil t) + (tabulated-list-init-header)) + +(defun org-export--stack-generate () + "Generate the asynchronous export stack for display. +Unavailable sources are removed from the list. Return a list +appropriate for `tabulated-list-print'." + ;; Clear stack from exited processes, dead buffers or non-existent + ;; files. + (setq org-export-stack-contents + (cl-remove-if-not + (lambda (el) + (if (processp (nth 2 el)) + (buffer-live-p (process-buffer (nth 2 el))) + (let ((source (car el))) + (if (bufferp source) (buffer-live-p source) + (file-exists-p source))))) + org-export-stack-contents)) + ;; Update `tabulated-list-entries'. + (let ((counter 0)) + (mapcar + (lambda (entry) + (let ((source (car entry))) + (list source + (vector + ;; Counter. + (number-to-string (cl-incf counter)) + ;; Back-End. + (if (nth 1 entry) (symbol-name (nth 1 entry)) "") + ;; Age. + (let ((info (nth 2 entry))) + (if (processp info) (symbol-name (process-status info)) + (format-seconds "%h:%.2m" (float-time (time-since info))))) + ;; Source. + (if (stringp source) source (buffer-name source)))))) + org-export-stack-contents))) + +(defun org-export--stack-num-predicate (a b) + (< (string-to-number (aref (nth 1 a) 0)) + (string-to-number (aref (nth 1 b) 0)))) + +(defun org-export--stack-source-at-point () + "Return source from export results at point in stack." + (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents)))) + (if (not source) (error "Source unavailable, please refresh buffer") + (let ((source-name (if (stringp source) source (buffer-name source)))) + (if (save-excursion + (beginning-of-line) + (looking-at-p (concat ".* +" (regexp-quote source-name) "$"))) + source + ;; SOURCE is not consistent with current line. The stack + ;; view is outdated. + (error (substitute-command-keys + "Source unavailable; type `\\[org-export-stack-refresh]' \ +to refresh buffer"))))))) + + + +;;; The Dispatcher +;; +;; `org-export-dispatch' is the standard interactive way to start an +;; export process. It uses `org-export--dispatch-ui' as a subroutine +;; for its interface, which, in turn, delegates response to key +;; pressed to `org-export--dispatch-action'. + +;;;###autoload +(defun org-export-dispatch (&optional arg) + "Export dispatcher for Org mode. + +It provides an access to common export related tasks in a buffer. +Its interface comes in two flavors: standard and expert. + +While both share the same set of bindings, only the former +displays the valid keys associations in a dedicated buffer. +Scrolling (resp. line-wise motion) in this buffer is done with +SPC and DEL (resp. C-n and C-p) keys. + +Set variable `org-export-dispatch-use-expert-ui' to switch to one +flavor or the other. + +When ARG is `\\[universal-argument]', repeat the last export action, with the\ + same +set of options used back then, on the current buffer. + +When ARG is `\\[universal-argument] \\[universal-argument]', display the \ +asynchronous export stack." + (interactive "P") + (let* ((input + (cond ((equal arg '(16)) '(stack)) + ((and arg org-export-dispatch-last-action)) + (t (save-window-excursion + (unwind-protect + (progn + ;; Remember where we are + (move-marker org-export-dispatch-last-position + (point) + (org-base-buffer (current-buffer))) + ;; Get and store an export command + (setq org-export-dispatch-last-action + (org-export--dispatch-ui + (list org-export-initial-scope + (and org-export-in-background 'async)) + nil + org-export-dispatch-use-expert-ui))) + (and (get-buffer "*Org Export Dispatcher*") + (kill-buffer "*Org Export Dispatcher*"))))))) + (action (car input)) + (optns (cdr input))) + (unless (memq 'subtree optns) + (move-marker org-export-dispatch-last-position nil)) + (cl-case action + ;; First handle special hard-coded actions. + (template (org-export-insert-default-template nil optns)) + (stack (org-export-stack)) + (publish-current-file + (org-publish-current-file (memq 'force optns) (memq 'async optns))) + (publish-current-project + (org-publish-current-project (memq 'force optns) (memq 'async optns))) + (publish-choose-project + (org-publish (assoc (completing-read + "Publish project: " + org-publish-project-alist nil t) + org-publish-project-alist) + (memq 'force optns) + (memq 'async optns))) + (publish-all (org-publish-all (memq 'force optns) (memq 'async optns))) + (otherwise + (save-excursion + (when arg + ;; Repeating command, maybe move cursor to restore subtree + ;; context. + (if (eq (marker-buffer org-export-dispatch-last-position) + (org-base-buffer (current-buffer))) + (goto-char org-export-dispatch-last-position) + ;; We are in a different buffer, forget position. + (move-marker org-export-dispatch-last-position nil))) + (funcall action + ;; Return a symbol instead of a list to ease + ;; asynchronous export macro use. + (and (memq 'async optns) t) + (and (memq 'subtree optns) t) + (and (memq 'visible optns) t) + (and (memq 'body optns) t))))))) + +(defun org-export--dispatch-ui (options first-key expertp) + "Handle interface for `org-export-dispatch'. + +OPTIONS is a list containing current interactive options set for +export. It can contain any of the following symbols: +`body' toggles a body-only export +`subtree' restricts export to current subtree +`visible' restricts export to visible part of buffer. +`force' force publishing files. +`async' use asynchronous export process + +FIRST-KEY is the key pressed to select the first level menu. It +is nil when this menu hasn't been selected yet. + +EXPERTP, when non-nil, triggers expert UI. In that case, no help +buffer is provided, but indications about currently active +options are given in the prompt. Moreover, [?] allows switching +back to standard interface." + (let* ((fontify-key + (lambda (key &optional access-key) + ;; Fontify KEY string. Optional argument ACCESS-KEY, when + ;; non-nil is the required first-level key to activate + ;; KEY. When its value is t, activate KEY independently + ;; on the first key, if any. A nil value means KEY will + ;; only be activated at first level. + (if (or (eq access-key t) (eq access-key first-key)) + (propertize key 'face 'org-dispatcher-highlight) + key))) + (fontify-value + (lambda (value) + ;; Fontify VALUE string. + (propertize value 'face 'font-lock-variable-name-face))) + ;; Prepare menu entries by extracting them from registered + ;; back-ends and sorting them by access key and by ordinal, + ;; if any. + (entries + (sort (sort (delq nil + (mapcar #'org-export-backend-menu + org-export-registered-backends)) + (lambda (a b) + (let ((key-a (nth 1 a)) + (key-b (nth 1 b))) + (cond ((and (numberp key-a) (numberp key-b)) + (< key-a key-b)) + ((numberp key-b) t))))) + #'car-less-than-car)) + ;; Compute a list of allowed keys based on the first key + ;; pressed, if any. Some keys + ;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always + ;; available. + (allowed-keys + (nconc (list 2 22 19 6 1) + (if (not first-key) (org-uniquify (mapcar #'car entries)) + (let (sub-menu) + (dolist (entry entries (sort (mapcar #'car sub-menu) #'<)) + (when (eq (car entry) first-key) + (setq sub-menu (append (nth 2 entry) sub-menu)))))) + (cond ((eq first-key ?P) (list ?f ?p ?x ?a)) + ((not first-key) (list ?P))) + (list ?& ?#) + (when expertp (list ??)) + (list ?q))) + ;; Build the help menu for standard UI. + (help + (unless expertp + (concat + ;; Options are hard-coded. + (format "[%s] Body only: %s [%s] Visible only: %s +\[%s] Export scope: %s [%s] Force publishing: %s +\[%s] Async export: %s\n\n" + (funcall fontify-key "C-b" t) + (funcall fontify-value + (if (memq 'body options) "On " "Off")) + (funcall fontify-key "C-v" t) + (funcall fontify-value + (if (memq 'visible options) "On " "Off")) + (funcall fontify-key "C-s" t) + (funcall fontify-value + (if (memq 'subtree options) "Subtree" "Buffer ")) + (funcall fontify-key "C-f" t) + (funcall fontify-value + (if (memq 'force options) "On " "Off")) + (funcall fontify-key "C-a" t) + (funcall fontify-value + (if (memq 'async options) "On " "Off"))) + ;; Display registered back-end entries. When a key + ;; appears for the second time, do not create another + ;; entry, but append its sub-menu to existing menu. + (let (last-key) + (mapconcat + (lambda (entry) + (let ((top-key (car entry))) + (concat + (unless (eq top-key last-key) + (setq last-key top-key) + (format "\n[%s] %s\n" + (funcall fontify-key (char-to-string top-key)) + (nth 1 entry))) + (let ((sub-menu (nth 2 entry))) + (unless (functionp sub-menu) + ;; Split sub-menu into two columns. + (let ((index -1)) + (concat + (mapconcat + (lambda (sub-entry) + (cl-incf index) + (format + (if (zerop (mod index 2)) " [%s] %-26s" + "[%s] %s\n") + (funcall fontify-key + (char-to-string (car sub-entry)) + top-key) + (nth 1 sub-entry))) + sub-menu "") + (when (zerop (mod index 2)) "\n")))))))) + entries "")) + ;; Publishing menu is hard-coded. + (format "\n[%s] Publish + [%s] Current file [%s] Current project + [%s] Choose project [%s] All projects\n\n\n" + (funcall fontify-key "P") + (funcall fontify-key "f" ?P) + (funcall fontify-key "p" ?P) + (funcall fontify-key "x" ?P) + (funcall fontify-key "a" ?P)) + (format "[%s] Export stack [%s] Insert template\n" + (funcall fontify-key "&" t) + (funcall fontify-key "#" t)) + (format "[%s] %s" + (funcall fontify-key "q" t) + (if first-key "Main menu" "Exit"))))) + ;; Build prompts for both standard and expert UI. + (standard-prompt (unless expertp "Export command: ")) + (expert-prompt + (when expertp + (format + "Export command (C-%s%s%s%s%s) [%s]: " + (if (memq 'body options) (funcall fontify-key "b" t) "b") + (if (memq 'visible options) (funcall fontify-key "v" t) "v") + (if (memq 'subtree options) (funcall fontify-key "s" t) "s") + (if (memq 'force options) (funcall fontify-key "f" t) "f") + (if (memq 'async options) (funcall fontify-key "a" t) "a") + (mapconcat (lambda (k) + ;; Strip control characters. + (unless (< k 27) (char-to-string k))) + allowed-keys ""))))) + ;; With expert UI, just read key with a fancy prompt. In standard + ;; UI, display an intrusive help buffer. + (if expertp + (org-export--dispatch-action + expert-prompt allowed-keys entries options first-key expertp) + ;; At first call, create frame layout in order to display menu. + (unless (get-buffer "*Org Export Dispatcher*") + (delete-other-windows) + (org-switch-to-buffer-other-window + (get-buffer-create "*Org Export Dispatcher*")) + (setq cursor-type nil + header-line-format "Use SPC, DEL, C-n or C-p to navigate.") + ;; Make sure that invisible cursor will not highlight square + ;; brackets. + (set-syntax-table (copy-syntax-table)) + (modify-syntax-entry ?\[ "w")) + ;; At this point, the buffer containing the menu exists and is + ;; visible in the current window. So, refresh it. + (with-current-buffer "*Org Export Dispatcher*" + ;; Refresh help. Maintain display continuity by re-visiting + ;; previous window position. + (let ((pt (point)) + (wstart (window-start))) + (erase-buffer) + (insert help) + (goto-char pt) + (set-window-start nil wstart))) + (org-fit-window-to-buffer) + (org-export--dispatch-action + standard-prompt allowed-keys entries options first-key expertp)))) + +(defun org-export--dispatch-action + (prompt allowed-keys entries options first-key expertp) + "Read a character from command input and act accordingly. + +PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is +a list of characters available at a given step in the process. +ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and +EXPERTP are the same as defined in `org-export--dispatch-ui', +which see. + +Toggle export options when required. Otherwise, return value is +a list with action as CAR and a list of interactive export +options as CDR." + (let (key) + ;; Scrolling: when in non-expert mode, act on motion keys (C-n, + ;; C-p, SPC, DEL). + (while (and (setq key (read-char-exclusive prompt)) + (not expertp) + ;; FIXME: Don't use C-v (22) here, as it is used as a + ;; modifier key in the export dispatch. + (memq key '(14 16 ?\s ?\d 134217846))) + (org-scroll key t)) + (cond + ;; Ignore undefined associations. + ((not (memq key allowed-keys)) + (ding) + (unless expertp (message "Invalid key") (sit-for 1)) + (org-export--dispatch-ui options first-key expertp)) + ;; q key at first level aborts export. At second level, cancel + ;; first key instead. + ((eq key ?q) (if (not first-key) (user-error "Export aborted") + (org-export--dispatch-ui options nil expertp))) + ;; Help key: Switch back to standard interface if expert UI was + ;; active. + ((eq key ??) (org-export--dispatch-ui options first-key nil)) + ;; Send request for template insertion along with export scope. + ((eq key ?#) (cons 'template (memq 'subtree options))) + ;; Switch to asynchronous export stack. + ((eq key ?&) '(stack)) + ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1). + ((memq key '(2 22 19 6 1)) + (org-export--dispatch-ui + (let ((option (cl-case key (2 'body) (22 'visible) (19 'subtree) + (6 'force) (1 'async)))) + (if (memq option options) (remq option options) + (cons option options))) + first-key expertp)) + ;; Action selected: Send key and options back to + ;; `org-export-dispatch'. + ((or first-key (functionp (nth 2 (assq key entries)))) + (cons (cond + ((not first-key) (nth 2 (assq key entries))) + ;; Publishing actions are hard-coded. Send a special + ;; signal to `org-export-dispatch'. + ((eq first-key ?P) + (cl-case key + (?f 'publish-current-file) + (?p 'publish-current-project) + (?x 'publish-choose-project) + (?a 'publish-all))) + ;; Return first action associated to FIRST-KEY + KEY + ;; path. Indeed, derived backends can share the same + ;; FIRST-KEY. + (t (catch 'found + (dolist (entry (member (assq first-key entries) entries)) + (let ((match (assq key (nth 2 entry)))) + (when match (throw 'found (nth 2 match)))))))) + options)) + ;; Otherwise, enter sub-menu. + (t (org-export--dispatch-ui options key expertp))))) + + + +(provide 'ox) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox.el ends here |