forked from mirrors/org-mode
ox: Introduce conditional/generated preamble
* lisp/ox.el (org-export-detect-features, org-export-expand-features, org-export-generate-features-preamble): New functions for detecting features and generating content based on them. (org-export-conditional-features): Customisation for feature detection. (org-export-as): Add detected to features to info in the slot :features. (org-export-update-features): Add a convenience function for users to edit the feature condition/implementation lists. (org-export--annotate-info, org-export-detect-features, org-export-define-derived-backend, org-export-define-backend, org-export-conditional-features): Refactor backend feature conditions/implementations into a struct field. This allows for parent inheritance to be properly managed, and leads into future work making features more widely used in the export process. (org-export-expand-features, org-export-resolve-feature-implementations, org-export-generate-features-preamble, org-export-expand-feature-snippets): The main functions for working with export features. (org-export-process-features, org-export-update-features): Introduce `org-export-process-features' to simplify the application of features to INFO.
This commit is contained in:
parent
62f45e2bab
commit
6be558e9cd
19
lisp/org.el
19
lisp/org.el
|
@ -3452,15 +3452,6 @@ header, or they will be appended."
|
||||||
;; inputenc and fontenc are for pdflatex only
|
;; inputenc and fontenc are for pdflatex only
|
||||||
("AUTO" "inputenc" t ("pdflatex"))
|
("AUTO" "inputenc" t ("pdflatex"))
|
||||||
("T1" "fontenc" t ("pdflatex"))
|
("T1" "fontenc" t ("pdflatex"))
|
||||||
("" "graphicx" t)
|
|
||||||
("" "longtable" nil)
|
|
||||||
("" "wrapfig" nil)
|
|
||||||
("" "rotating" nil)
|
|
||||||
("normalem" "ulem" t)
|
|
||||||
;; amsmath and amssymb after inputenc/fontenc for pdflatex
|
|
||||||
("" "amsmath" t ("pdflatex"))
|
|
||||||
("" "amssymb" t ("pdflatex"))
|
|
||||||
("" "capt-of" nil)
|
|
||||||
("" "hyperref" nil))
|
("" "hyperref" nil))
|
||||||
"Alist of default packages to be inserted in the header.
|
"Alist of default packages to be inserted in the header.
|
||||||
|
|
||||||
|
@ -3470,18 +3461,12 @@ incompatibility with another package you are using.
|
||||||
The packages in this list are needed by one part or another of
|
The packages in this list are needed by one part or another of
|
||||||
Org mode to function properly:
|
Org mode to function properly:
|
||||||
|
|
||||||
|
- amsmath: for subscript and superscript and math environments
|
||||||
|
(automatically added when needed with pdflatex).
|
||||||
- fontspec: for font and character selection in lualatex and xetex
|
- fontspec: for font and character selection in lualatex and xetex
|
||||||
- inputenc, fontenc: for basic font and character selection
|
- inputenc, fontenc: for basic font and character selection
|
||||||
in pdflatex
|
|
||||||
- graphicx: for including images
|
|
||||||
- longtable: For multipage tables
|
|
||||||
- wrapfig: for figure placement
|
- wrapfig: for figure placement
|
||||||
- rotating: for sideways figures and tables
|
- rotating: for sideways figures and tables
|
||||||
- ulem: for underline and strike-through
|
|
||||||
- amsmath: for subscript and superscript and math environments
|
|
||||||
- amssymb: for various symbols used for interpreting the entities
|
|
||||||
in `org-entities'. You can skip some of this package if you don't
|
|
||||||
use any of the symbols.
|
|
||||||
- capt-of: for captions outside of floats
|
- capt-of: for captions outside of floats
|
||||||
- hyperref: for cross references
|
- hyperref: for cross references
|
||||||
|
|
||||||
|
|
|
@ -847,9 +847,7 @@ holding export options."
|
||||||
;; Timestamp.
|
;; Timestamp.
|
||||||
(and (plist-get info :time-stamp-file)
|
(and (plist-get info :time-stamp-file)
|
||||||
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
|
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
|
||||||
;; LaTeX compiler
|
;; Document class, packages, and some configuration.
|
||||||
(org-latex--insert-compiler info)
|
|
||||||
;; Document class and packages.
|
|
||||||
(org-latex-make-preamble info)
|
(org-latex-make-preamble info)
|
||||||
;; Define the alternative frame environment.
|
;; Define the alternative frame environment.
|
||||||
(unless (equal "frame" org-beamer-frame-environment)
|
(unless (equal "frame" org-beamer-frame-environment)
|
||||||
|
@ -902,12 +900,6 @@ holding export options."
|
||||||
(let ((template (plist-get info :latex-hyperref-template)))
|
(let ((template (plist-get info :latex-hyperref-template)))
|
||||||
(and (stringp template)
|
(and (stringp template)
|
||||||
(format-spec template (org-latex--format-spec info))))
|
(format-spec template (org-latex--format-spec info))))
|
||||||
;; engrave-faces-latex preamble
|
|
||||||
(when (and (eq (plist-get info :latex-src-block-backend) 'engraved)
|
|
||||||
(org-element-map (plist-get info :parse-tree)
|
|
||||||
'(src-block inline-src-block) #'identity
|
|
||||||
info t))
|
|
||||||
(org-latex-generate-engraved-preamble info))
|
|
||||||
;; Document start.
|
;; Document start.
|
||||||
"\\begin{document}\n\n"
|
"\\begin{document}\n\n"
|
||||||
;; Title command.
|
;; Title command.
|
||||||
|
|
347
lisp/ox-latex.el
347
lisp/ox-latex.el
|
@ -170,7 +170,83 @@
|
||||||
(:latex-toc-command nil nil org-latex-toc-command)
|
(:latex-toc-command nil nil org-latex-toc-command)
|
||||||
(:latex-compiler "LATEX_COMPILER" nil org-latex-compiler)
|
(:latex-compiler "LATEX_COMPILER" nil org-latex-compiler)
|
||||||
;; Redefine regular options.
|
;; Redefine regular options.
|
||||||
(:date "DATE" nil "\\today" parse)))
|
(:date "DATE" nil "\\today" parse))
|
||||||
|
:feature-conditions-alist
|
||||||
|
`((t !announce-start !announce-end
|
||||||
|
!guess-pollyglossia !guess-babel !guess-inputenc)
|
||||||
|
(,(lambda (info)
|
||||||
|
;; Since amsmath is added unconditionally when using
|
||||||
|
;; xelatex/lualatex (see `org-latex-default-packages-alist'),
|
||||||
|
;; and amssymb is not needed, we need not bother when using
|
||||||
|
;; thoese compilers.
|
||||||
|
(and (not (member (plist-get info :latex-compiler) '("xelatex" "lualatex")))
|
||||||
|
(org-element-map (plist-get info :parse-tree)
|
||||||
|
'(latex-fragment latex-environment) #'identity info t)))
|
||||||
|
maths)
|
||||||
|
(,(lambda (info)
|
||||||
|
(org-element-map (plist-get info :parse-tree)
|
||||||
|
'underline #'identity info t))
|
||||||
|
underline)
|
||||||
|
("\\\\uu?line\\|\\\\uwave\\|\\\\sout\\|\\\\xout\\|\\\\dashuline\\|\\dotuline\\|\\markoverwith"
|
||||||
|
underline)
|
||||||
|
(,(lambda (info)
|
||||||
|
(org-element-map (plist-get info :parse-tree)
|
||||||
|
'link
|
||||||
|
(lambda (link)
|
||||||
|
(and (member (org-element-property :type link)
|
||||||
|
'("http" "https" "ftp" "file"))
|
||||||
|
(file-name-extension (org-element-property :path link))
|
||||||
|
(equal (downcase (file-name-extension
|
||||||
|
(org-element-property :path link)))
|
||||||
|
"svg")))
|
||||||
|
info t))
|
||||||
|
svg)
|
||||||
|
(org-latex-tables-booktabs booktabs)
|
||||||
|
(,(lambda (info)
|
||||||
|
(equal (plist-get info :latex-default-table-environment)
|
||||||
|
"longtable"))
|
||||||
|
longtable)
|
||||||
|
("^[ \t]*\\+attr_latex: .*:environment +longtable"
|
||||||
|
longtable)
|
||||||
|
(,(lambda (info)
|
||||||
|
(eq (plist-get info :latex-src-block-backend) 'engraved))
|
||||||
|
engraved-code)
|
||||||
|
("^[ \t]*#\\+attr_latex: .*:float +wrap"
|
||||||
|
float-wrap)
|
||||||
|
("^[ \t]*#\\+attr_latex: .*:float +sideways"
|
||||||
|
rotate)
|
||||||
|
("^[ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\|\\\\caption{" caption))
|
||||||
|
:feature-implementations-alist
|
||||||
|
`((!announce-start
|
||||||
|
:snippet ,(lambda (info)
|
||||||
|
(with-temp-buffer
|
||||||
|
(setq-local left-margin 2)
|
||||||
|
(insert (string-join
|
||||||
|
(mapcar #'symbol-name
|
||||||
|
(plist-get info :features))
|
||||||
|
", ")
|
||||||
|
".")
|
||||||
|
(fill-region-as-paragraph (point-min) (point-max))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(insert "%% ox-latex features:\n% ")
|
||||||
|
(while (search-forward "\n" nil t)
|
||||||
|
(insert "%"))
|
||||||
|
(buffer-string)))
|
||||||
|
:order -100)
|
||||||
|
(maths :snippet "\\usepackage{amsmath}\n\\usepackage{amssymb}" :order 0.2)
|
||||||
|
(underline :snippet "\\usepackage[normalem]{ulem}" :order 0.5)
|
||||||
|
(image :snippet "\\usepackage{graphicx}" :order 2)
|
||||||
|
(svg :snippet "\\usepackage[inkscapelatex=false]{svg}" :order 2 :when image)
|
||||||
|
(longtable :snippet "\\usepackage{longtable}" :when table :order 2)
|
||||||
|
(booktabs :snippet "\\usepackage{booktabs}" :when table :order 2)
|
||||||
|
(float-wrap :snippet "\\usepackage{wrapfig}" :order 2)
|
||||||
|
(rotate :snippet "\\usepackage{rotating}" :order 2)
|
||||||
|
(caption :snippet "\\usepackage{capt-of}")
|
||||||
|
(engraved-code :when code :snippet org-latex-generate-engraved-preamble)
|
||||||
|
(!guess-pollyglossia :snippet org-latex-guess-polyglossia-language)
|
||||||
|
(!guess-babel :snippet org-latex-guess-babel-language)
|
||||||
|
(!guess-inputenc :snippet org-latex-guess-inputenc)
|
||||||
|
(!announce-end :snippet "%% end ox-latex features\n" :order 100)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -1353,7 +1429,7 @@ default values of which are given by `org-latex-engraved-preamble' and
|
||||||
t t
|
t t
|
||||||
engraved-preamble)))
|
engraved-preamble)))
|
||||||
(concat
|
(concat
|
||||||
"\n% Setup for code blocks [1/2]\n\n"
|
"% Setup for code blocks [1/2]\n\n"
|
||||||
engraved-preamble
|
engraved-preamble
|
||||||
"\n\n% Setup for code blocks [2/2]: syntax highlighting colors\n\n"
|
"\n\n% Setup for code blocks [2/2]: syntax highlighting colors\n\n"
|
||||||
(if (require 'engrave-faces-latex nil t)
|
(if (require 'engrave-faces-latex nil t)
|
||||||
|
@ -1627,29 +1703,29 @@ For non-floats, see `org-latex--wrap-label'."
|
||||||
(org-trim label)
|
(org-trim label)
|
||||||
(org-export-data main info))))))
|
(org-export-data main info))))))
|
||||||
|
|
||||||
(defun org-latex-guess-inputenc (header)
|
(defun org-latex-guess-inputenc (info)
|
||||||
"Set the coding system in inputenc to what the buffer is.
|
"Set the coding system in inputenc to what the buffer is.
|
||||||
|
|
||||||
HEADER is the LaTeX header string. This function only applies
|
INFO is the plist used as a communication channel.
|
||||||
when specified inputenc option is \"AUTO\".
|
This function only applies when specified inputenc option is \"AUTO\".
|
||||||
|
|
||||||
Return the new header, as a string."
|
Return the new header, as a string."
|
||||||
(let* ((cs (or (ignore-errors
|
(let ((header (plist-get info :latex-full-header))
|
||||||
(latexenc-coding-system-to-inputenc
|
(cs (or (ignore-errors
|
||||||
(or org-export-coding-system buffer-file-coding-system)))
|
(latexenc-coding-system-to-inputenc
|
||||||
"utf8")))
|
(or org-export-coding-system buffer-file-coding-system)))
|
||||||
(if (not cs) header
|
"utf8")))
|
||||||
|
(when (and cs (string-match "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" header))
|
||||||
;; First translate if that is requested.
|
;; First translate if that is requested.
|
||||||
(setq cs (or (cdr (assoc cs org-latex-inputenc-alist)) cs))
|
(setq cs (or (cdr (assoc cs org-latex-inputenc-alist)) cs))
|
||||||
;; Then find the \usepackage statement and replace the option.
|
(plist-put info :latex-full-header
|
||||||
(replace-regexp-in-string "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}"
|
(replace-match cs t t header 1))))
|
||||||
cs header t nil 1))))
|
nil)
|
||||||
|
|
||||||
(defun org-latex-guess-babel-language (header info)
|
(defun org-latex-guess-babel-language (info)
|
||||||
"Set Babel's language according to LANGUAGE keyword.
|
"Set Babel's language according to LANGUAGE keyword.
|
||||||
|
|
||||||
HEADER is the LaTeX header string. INFO is the plist used as
|
INFO is the plist used as a communication channel.
|
||||||
a communication channel.
|
|
||||||
|
|
||||||
Insertion of guessed language only happens when Babel package has
|
Insertion of guessed language only happens when Babel package has
|
||||||
explicitly been loaded. Then it is added to the rest of
|
explicitly been loaded. Then it is added to the rest of
|
||||||
|
@ -1663,52 +1739,48 @@ already loaded.
|
||||||
|
|
||||||
Return the new header."
|
Return the new header."
|
||||||
(let* ((language-code (plist-get info :language))
|
(let* ((language-code (plist-get info :language))
|
||||||
(plist (cdr
|
(plist (cdr (assoc language-code org-latex-language-alist)))
|
||||||
(assoc language-code org-latex-language-alist)))
|
(language (plist-get plist :babel))
|
||||||
(language (plist-get plist :babel))
|
(header (plist-get info :latex-full-header))
|
||||||
(language-ini-only (plist-get plist :babel-ini-only))
|
(language-ini-only (plist-get plist :babel-ini-only))
|
||||||
(language-ini-alt (plist-get plist :babel-ini-alt))
|
(language-ini-alt (plist-get plist :babel-ini-alt))
|
||||||
;; If no language is set, or Babel package is not loaded, or
|
(babel-header-options
|
||||||
;; LANGUAGE keyword value is a language served by Babel
|
;; If no language is set, or Babel package is not loaded, or
|
||||||
;; exclusively through ini files, return HEADER as-is.
|
;; LANGUAGE keyword value is a language served by Babel
|
||||||
(header (if (or language-ini-only
|
;; exclusively through ini files, return HEADER as-is.
|
||||||
(not (stringp language-code))
|
(and (not language-ini-only)
|
||||||
(not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header)))
|
(stringp language-code)
|
||||||
header
|
(string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header)
|
||||||
(let ((options (save-match-data
|
(let ((options (save-match-data
|
||||||
(org-split-string (match-string 1 header) ",[ \t]*"))))
|
(org-split-string (match-string 1 header) ",[ \t]*"))))
|
||||||
;; If LANGUAGE is already loaded, return header
|
(cond ((member language options) (delete "AUTO" options))
|
||||||
;; without AUTO. Otherwise, replace AUTO with language or
|
((member "AUTO" options) options)
|
||||||
;; append language if AUTO is not present. Languages that are
|
(t (append options (list language))))))))
|
||||||
;; served in Babel exclusively through ini files are not added
|
(when babel-header-options
|
||||||
;; to the babel argument, and must be loaded using
|
;; If AUTO is present in the header options, replace it with `language'.
|
||||||
;; `\babelprovide'.
|
(setq header
|
||||||
(replace-match
|
(replace-match
|
||||||
(mapconcat (lambda (option) (if (equal "AUTO" option) language option))
|
(mapconcat (lambda (option) (if (equal "AUTO" option) language option))
|
||||||
(cond ((member language options) (delete "AUTO" options))
|
babel-header-options
|
||||||
((member "AUTO" options) options)
|
", ")
|
||||||
(t (append options (list language))))
|
t nil header 1)))
|
||||||
", ")
|
|
||||||
t nil header 1)))))
|
|
||||||
;; If `\babelprovide[args]{AUTO}' is present, AUTO is
|
;; If `\babelprovide[args]{AUTO}' is present, AUTO is
|
||||||
;; replaced by LANGUAGE.
|
;; replaced by LANGUAGE.
|
||||||
(if (not (string-match "\\\\babelprovide\\[.*\\]{\\(.+\\)}" header))
|
(when (string-match "\\\\babelprovide\\[.*\\]{AUTO}" header)
|
||||||
header
|
(setq header
|
||||||
(let ((prov (match-string 1 header)))
|
(replace-regexp-in-string
|
||||||
(if (equal "AUTO" prov)
|
(format
|
||||||
(replace-regexp-in-string (format
|
"\\(\\\\babelprovide\\[.*\\]\\)\\({\\)%s}" babel-header-options)
|
||||||
"\\(\\\\babelprovide\\[.*\\]\\)\\({\\)%s}" prov)
|
(format "\\1\\2%s}" (if language-ini-alt language-ini-alt
|
||||||
(format "\\1\\2%s}"
|
(or language language-ini-only)))
|
||||||
(if language-ini-alt language-ini-alt
|
header t)))
|
||||||
(or language language-ini-only)))
|
(plist-put info :latex-full-header header))
|
||||||
header t)
|
nil)
|
||||||
header)))))
|
|
||||||
|
|
||||||
(defun org-latex-guess-polyglossia-language (header info)
|
(defun org-latex-guess-polyglossia-language (info)
|
||||||
"Set the Polyglossia language according to the LANGUAGE keyword.
|
"Set the Polyglossia language according to the LANGUAGE keyword.
|
||||||
|
|
||||||
HEADER is the LaTeX header string. INFO is the plist used as
|
INFO is the plist used as a communication channel.
|
||||||
a communication channel.
|
|
||||||
|
|
||||||
Insertion of guessed language only happens when the Polyglossia
|
Insertion of guessed language only happens when the Polyglossia
|
||||||
package has been explicitly loaded.
|
package has been explicitly loaded.
|
||||||
|
@ -1719,48 +1791,50 @@ replaced with the language of the document or
|
||||||
using \setdefaultlanguage and not as an option to the package.
|
using \setdefaultlanguage and not as an option to the package.
|
||||||
|
|
||||||
Return the new header."
|
Return the new header."
|
||||||
(let* ((language (plist-get info :language)))
|
(let ((header (plist-get info :latex-full-header))
|
||||||
|
(language (plist-get info :language)))
|
||||||
;; If no language is set or Polyglossia is not loaded, return
|
;; If no language is set or Polyglossia is not loaded, return
|
||||||
;; HEADER as-is.
|
;; HEADER as-is.
|
||||||
(if (or (not (stringp language))
|
(when (and (stringp language)
|
||||||
(not (string-match
|
(string-match
|
||||||
"\\\\usepackage\\(?:\\[\\([^]]+?\\)\\]\\){polyglossia}\n"
|
"\\\\usepackage\\(?:\\[\\([^]]+?\\)\\]\\){polyglossia}\n"
|
||||||
header)))
|
header))
|
||||||
header
|
|
||||||
(let* ((options (org-string-nw-p (match-string 1 header)))
|
(let* ((options (org-string-nw-p (match-string 1 header)))
|
||||||
(languages (and options
|
(languages (and options
|
||||||
;; Reverse as the last loaded language is
|
;; Reverse as the last loaded language is
|
||||||
;; the main language.
|
;; the main language.
|
||||||
(nreverse
|
(nreverse
|
||||||
(delete-dups
|
(delete-dups
|
||||||
(save-match-data
|
(save-match-data
|
||||||
(org-split-string
|
(org-split-string
|
||||||
(replace-regexp-in-string
|
(replace-regexp-in-string
|
||||||
"AUTO" language options t)
|
"AUTO" language options t)
|
||||||
",[ \t]*"))))))
|
",[ \t]*"))))))
|
||||||
(main-language-set
|
(main-language-set
|
||||||
(string-match-p "\\\\setmainlanguage{.*?}" header)))
|
(string-match-p "\\\\setmainlanguage{.*?}" header))
|
||||||
(replace-match
|
(polyglossia-modified-header
|
||||||
(concat "\\usepackage{polyglossia}\n"
|
(replace-match
|
||||||
(mapconcat
|
(concat "\\usepackage{polyglossia}\n"
|
||||||
(lambda (l)
|
(mapconcat
|
||||||
(let* ((plist (cdr
|
(lambda (l)
|
||||||
(assoc language org-latex-language-alist)))
|
(let* ((plist (cdr (assoc language org-latex-language-alist)))
|
||||||
(polyglossia-variant (plist-get plist :polyglossia-variant))
|
(polyglossia-variant (plist-get plist :polyglossia-variant))
|
||||||
(polyglossia-lang (plist-get plist :polyglossia))
|
(polyglossia-lang (plist-get plist :polyglossia))
|
||||||
(l (if (equal l language)
|
(l (if (equal l language)
|
||||||
polyglossia-lang
|
polyglossia-lang
|
||||||
l)))
|
l)))
|
||||||
(format (if main-language-set (format "\\setotherlanguage{%s}\n" l)
|
(format (if main-language-set (format "\\setotherlanguage{%s}\n" l)
|
||||||
(setq main-language-set t)
|
(setq main-language-set t)
|
||||||
"\\setmainlanguage%s{%s}\n")
|
"\\setmainlanguage%s{%s}\n")
|
||||||
(if polyglossia-variant
|
(if polyglossia-variant
|
||||||
(format "[variant=%s]" polyglossia-variant)
|
(format "[variant=%s]" polyglossia-variant)
|
||||||
"")
|
"")
|
||||||
l)))
|
l)))
|
||||||
languages
|
languages
|
||||||
""))
|
""))
|
||||||
t t header 0)))))
|
t t header 0)))
|
||||||
|
(plist-put info :latex-full-header polyglossia-modified-header))))
|
||||||
|
nil)
|
||||||
|
|
||||||
(defun org-latex--remove-packages (pkg-alist info)
|
(defun org-latex--remove-packages (pkg-alist info)
|
||||||
"Remove packages based on the current LaTeX compiler.
|
"Remove packages based on the current LaTeX compiler.
|
||||||
|
@ -1965,32 +2039,50 @@ non-nil, only includes packages relevant to image generation, as
|
||||||
specified in `org-latex-default-packages-alist' or
|
specified in `org-latex-default-packages-alist' or
|
||||||
`org-latex-packages-alist'."
|
`org-latex-packages-alist'."
|
||||||
(let* ((class (plist-get info :latex-class))
|
(let* ((class (plist-get info :latex-class))
|
||||||
(class-template
|
(class-template
|
||||||
(or template
|
(or template
|
||||||
(let* ((class-options (plist-get info :latex-class-options))
|
(let* ((class-options (plist-get info :latex-class-options))
|
||||||
(header (nth 1 (assoc class (plist-get info :latex-classes)))))
|
(header (nth 1 (assoc class (plist-get info :latex-classes)))))
|
||||||
(and (stringp header)
|
(and (stringp header)
|
||||||
(if (not class-options) header
|
(if (not class-options) header
|
||||||
(replace-regexp-in-string
|
(replace-regexp-in-string
|
||||||
"^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
|
"^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
|
||||||
class-options header t nil 1))))
|
class-options header t nil 1))))
|
||||||
(user-error "Unknown LaTeX class `%s'" class))))
|
(user-error "Unknown LaTeX class `%s'" class)))
|
||||||
(org-latex-guess-polyglossia-language
|
generated-preamble)
|
||||||
(org-latex-guess-babel-language
|
(plist-put info :latex-full-header
|
||||||
(org-latex-guess-inputenc
|
(org-element-normalize-string
|
||||||
(org-element-normalize-string
|
(org-splice-latex-header
|
||||||
(org-splice-latex-header
|
class-template
|
||||||
class-template
|
(org-latex--remove-packages org-latex-default-packages-alist info)
|
||||||
(org-latex--remove-packages org-latex-default-packages-alist info)
|
(org-latex--remove-packages org-latex-packages-alist info)
|
||||||
(org-latex--remove-packages org-latex-packages-alist info)
|
snippet?
|
||||||
snippet?
|
(mapconcat #'org-element-normalize-string
|
||||||
(mapconcat #'org-element-normalize-string
|
(list (plist-get info :latex-header)
|
||||||
(list (plist-get info :latex-header)
|
(and (not snippet?)
|
||||||
(and (not snippet?)
|
(plist-get info :latex-header-extra)))
|
||||||
(plist-get info :latex-header-extra)))
|
""))))
|
||||||
""))))
|
(setq generated-preamble
|
||||||
info)
|
(if snippet?
|
||||||
info)))
|
(progn
|
||||||
|
(org-latex-guess-inputenc info)
|
||||||
|
(org-latex-guess-babel-language info)
|
||||||
|
(org-latex-guess-polyglossia-language info)
|
||||||
|
"\n% Generated preamble omitted for snippets.")
|
||||||
|
(concat
|
||||||
|
"\n"
|
||||||
|
(string-join
|
||||||
|
(org-export-expand-feature-snippets info)
|
||||||
|
"\n\n")
|
||||||
|
"\n")))
|
||||||
|
(concat
|
||||||
|
;; Time-stamp.
|
||||||
|
(and (plist-get info :time-stamp-file)
|
||||||
|
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
|
||||||
|
;; LaTeX compiler.
|
||||||
|
(org-latex--insert-compiler info)
|
||||||
|
(plist-get info :latex-full-header)
|
||||||
|
generated-preamble)))
|
||||||
|
|
||||||
(defun org-latex-template (contents info)
|
(defun org-latex-template (contents info)
|
||||||
"Return complete document string after LaTeX conversion.
|
"Return complete document string after LaTeX conversion.
|
||||||
|
@ -1999,12 +2091,7 @@ holding export options."
|
||||||
(let ((title (org-export-data (plist-get info :title) info))
|
(let ((title (org-export-data (plist-get info :title) info))
|
||||||
(spec (org-latex--format-spec info)))
|
(spec (org-latex--format-spec info)))
|
||||||
(concat
|
(concat
|
||||||
;; Timestamp.
|
;; Timestamp, compiler statement, document class and packages.
|
||||||
(and (plist-get info :time-stamp-file)
|
|
||||||
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
|
|
||||||
;; LaTeX compiler.
|
|
||||||
(org-latex--insert-compiler info)
|
|
||||||
;; Document class and packages.
|
|
||||||
(org-latex-make-preamble info)
|
(org-latex-make-preamble info)
|
||||||
;; Possibly limit depth for headline numbering.
|
;; Possibly limit depth for headline numbering.
|
||||||
(let ((sec-num (plist-get info :section-numbers)))
|
(let ((sec-num (plist-get info :section-numbers)))
|
||||||
|
@ -2041,12 +2128,6 @@ holding export options."
|
||||||
(let ((template (plist-get info :latex-hyperref-template)))
|
(let ((template (plist-get info :latex-hyperref-template)))
|
||||||
(and (stringp template)
|
(and (stringp template)
|
||||||
(format-spec template spec)))
|
(format-spec template spec)))
|
||||||
;; engrave-faces-latex preamble
|
|
||||||
(when (and (eq (plist-get info :latex-src-block-backend) 'engraved)
|
|
||||||
(org-element-map (plist-get info :parse-tree)
|
|
||||||
'(src-block inline-src-block) #'identity
|
|
||||||
info t))
|
|
||||||
(org-latex-generate-engraved-preamble info))
|
|
||||||
;; Document start.
|
;; Document start.
|
||||||
"\\begin{document}\n\n"
|
"\\begin{document}\n\n"
|
||||||
;; Title command.
|
;; Title command.
|
||||||
|
|
620
lisp/ox.el
620
lisp/ox.el
|
@ -1060,7 +1060,7 @@ mode."
|
||||||
|
|
||||||
(cl-defstruct (org-export-backend (:constructor org-export-create-backend)
|
(cl-defstruct (org-export-backend (:constructor org-export-create-backend)
|
||||||
(:copier nil))
|
(:copier nil))
|
||||||
name parent transcoders options filters blocks menu)
|
name parent transcoders options filters blocks menu feature-conditions feature-implementations)
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun org-export-get-backend (name)
|
(defun org-export-get-backend (name)
|
||||||
|
@ -1166,6 +1166,62 @@ returns filters inherited from parent backends, if any."
|
||||||
(setq filters (append filters (org-export-backend-filters backend))))
|
(setq filters (append filters (org-export-backend-filters backend))))
|
||||||
filters)))
|
filters)))
|
||||||
|
|
||||||
|
(defvar org-export-conditional-features)
|
||||||
|
|
||||||
|
(defun org-export-get-all-feature-conditions (backend)
|
||||||
|
"Return full feature condition alist 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 feature conditions, and values are feature symbols.
|
||||||
|
|
||||||
|
Unlike `org-export-backend-feature-conditions', this function
|
||||||
|
also returns conditions inherited from parent back-ends, if any."
|
||||||
|
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
|
||||||
|
(and backend
|
||||||
|
(let ((conditions (org-export-backend-feature-conditions backend))
|
||||||
|
parent)
|
||||||
|
(while (setq parent (org-export-backend-parent backend))
|
||||||
|
(setq backend (org-export-get-backend parent))
|
||||||
|
(dolist (condition (org-export-backend-feature-conditions backend))
|
||||||
|
(push condition conditions)))
|
||||||
|
(dolist (condition org-export-conditional-features)
|
||||||
|
(unless (assq (car condition) conditions)
|
||||||
|
(push condition conditions)))
|
||||||
|
conditions)))
|
||||||
|
|
||||||
|
(defun org-export-get-all-feature-implementations (backend)
|
||||||
|
"Return full feature implementation alist 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 feature symbols, and values are an implementation
|
||||||
|
specification plist.
|
||||||
|
|
||||||
|
Unlike `org-export-backend-feature-implementations', this function
|
||||||
|
also returns implementations inherited from parent back-ends, if any."
|
||||||
|
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
|
||||||
|
(and backend
|
||||||
|
(let ((implementations (org-export-backend-feature-implementations backend))
|
||||||
|
parent)
|
||||||
|
(while (setq parent (org-export-backend-parent backend))
|
||||||
|
(setq backend (org-export-get-backend parent))
|
||||||
|
(dolist (implementation (org-export-backend-feature-implementations backend))
|
||||||
|
(unless (assq (car implementation) implementations)
|
||||||
|
(push implementation implementations))))
|
||||||
|
implementations)))
|
||||||
|
|
||||||
|
(defun org-export-install-features (info)
|
||||||
|
"Install feature conditions and implementations in the communication channel.
|
||||||
|
INFO is a plist containing the current communication channel.
|
||||||
|
Return the updated communication channel."
|
||||||
|
(plist-put info :feature-conditions
|
||||||
|
(org-export-get-all-feature-conditions
|
||||||
|
(plist-get info :back-end)))
|
||||||
|
(plist-put info :feature-implementations
|
||||||
|
(org-export-get-all-feature-implementations
|
||||||
|
(plist-get info :back-end))))
|
||||||
|
|
||||||
(defun org-export-define-backend (backend transcoders &rest body)
|
(defun org-export-define-backend (backend transcoders &rest body)
|
||||||
"Define a new backend BACKEND.
|
"Define a new backend BACKEND.
|
||||||
|
|
||||||
|
@ -1277,20 +1333,24 @@ keywords are understood:
|
||||||
`org-export-options-alist' for more information about
|
`org-export-options-alist' for more information about
|
||||||
structure of the values."
|
structure of the values."
|
||||||
(declare (indent 1))
|
(declare (indent 1))
|
||||||
(let (filters menu-entry options)
|
(let (filters menu-entry options feature-conditions feature-implementations)
|
||||||
(while (keywordp (car body))
|
(while (keywordp (car body))
|
||||||
(let ((keyword (pop body)))
|
(let ((keyword (pop body)))
|
||||||
(pcase keyword
|
(pcase keyword
|
||||||
(:filters-alist (setq filters (pop body)))
|
(:filters-alist (setq filters (pop body)))
|
||||||
(:menu-entry (setq menu-entry (pop body)))
|
(:menu-entry (setq menu-entry (pop body)))
|
||||||
(:options-alist (setq options (pop body)))
|
(:options-alist (setq options (pop body)))
|
||||||
|
(:feature-conditions-alist (setq feature-conditions (pop body)))
|
||||||
|
(:feature-implementations-alist (setq feature-implementations (pop body)))
|
||||||
(_ (error "Unknown keyword: %s" keyword)))))
|
(_ (error "Unknown keyword: %s" keyword)))))
|
||||||
(org-export-register-backend
|
(org-export-register-backend
|
||||||
(org-export-create-backend :name backend
|
(org-export-create-backend :name backend
|
||||||
:transcoders transcoders
|
:transcoders transcoders
|
||||||
:options options
|
:options options
|
||||||
:filters filters
|
:filters filters
|
||||||
:menu menu-entry))))
|
:menu menu-entry
|
||||||
|
:feature-conditions feature-conditions
|
||||||
|
:feature-implementations feature-implementations))))
|
||||||
|
|
||||||
(defun org-export-define-derived-backend (child parent &rest body)
|
(defun org-export-define-derived-backend (child parent &rest body)
|
||||||
"Create a new backend as a variant of an existing one.
|
"Create a new backend as a variant of an existing one.
|
||||||
|
@ -1337,7 +1397,7 @@ The backend could then be called with, for example:
|
||||||
|
|
||||||
(org-export-to-buffer \\='my-latex \"*Test my-latex*\")"
|
(org-export-to-buffer \\='my-latex \"*Test my-latex*\")"
|
||||||
(declare (indent 2))
|
(declare (indent 2))
|
||||||
(let (filters menu-entry options transcoders)
|
(let (filters menu-entry options transcoders feature-conditions feature-implementations)
|
||||||
(while (keywordp (car body))
|
(while (keywordp (car body))
|
||||||
(let ((keyword (pop body)))
|
(let ((keyword (pop body)))
|
||||||
(pcase keyword
|
(pcase keyword
|
||||||
|
@ -1345,6 +1405,8 @@ The backend could then be called with, for example:
|
||||||
(:menu-entry (setq menu-entry (pop body)))
|
(:menu-entry (setq menu-entry (pop body)))
|
||||||
(:options-alist (setq options (pop body)))
|
(:options-alist (setq options (pop body)))
|
||||||
(:translate-alist (setq transcoders (pop body)))
|
(:translate-alist (setq transcoders (pop body)))
|
||||||
|
(:feature-conditions-alist (setq feature-conditions (pop body)))
|
||||||
|
(:feature-implementations-alist (setq feature-implementations (pop body)))
|
||||||
(_ (error "Unknown keyword: %s" keyword)))))
|
(_ (error "Unknown keyword: %s" keyword)))))
|
||||||
(org-export-register-backend
|
(org-export-register-backend
|
||||||
(org-export-create-backend :name child
|
(org-export-create-backend :name child
|
||||||
|
@ -1352,7 +1414,9 @@ The backend could then be called with, for example:
|
||||||
:transcoders transcoders
|
:transcoders transcoders
|
||||||
:options options
|
:options options
|
||||||
:filters filters
|
:filters filters
|
||||||
:menu menu-entry))))
|
:menu menu-entry
|
||||||
|
:feature-conditions feature-conditions
|
||||||
|
:feature-implementations feature-implementations))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -2055,6 +2119,550 @@ keywords before output."
|
||||||
(funcall (intern (format "org-element-%s-interpreter" type))
|
(funcall (intern (format "org-element-%s-interpreter" type))
|
||||||
blob contents))))
|
blob contents))))
|
||||||
|
|
||||||
|
|
||||||
|
;;; Conditional/Generated Features
|
||||||
|
;;
|
||||||
|
;; Many formats have some version of a preamble, whether it be HTML's
|
||||||
|
;; <head>...</head> or the content before LaTeX's \begin{document}.
|
||||||
|
;; Depending on the particular features in the Org document being
|
||||||
|
;; exported, different setup snippets will be needed. There's the
|
||||||
|
;; "everything and the kitchen sink" approach of adding absolutely
|
||||||
|
;; everything that might be needed, and the post-translation editing
|
||||||
|
;; with filters approach, but neither really solve this problem nicely.
|
||||||
|
;;
|
||||||
|
;; The conditional/generated preamble defines mechanisms of detecting
|
||||||
|
;; which "export features" are used in a document, handles
|
||||||
|
;; interactions between features, and provides/generates content to
|
||||||
|
;; support the features.
|
||||||
|
;;
|
||||||
|
;; Each export feature condition takes the form of a
|
||||||
|
;; (CONDITION . FEATURES) cons cell (see `org-export-detect-features'),
|
||||||
|
;; and each implementation takes the form of a (FEATURE . (:KEY VALUE ...))
|
||||||
|
;; associated plist (see `org-export-resolve-feature-implementations'
|
||||||
|
;; and `org-export-expand-feature-snippets').
|
||||||
|
;;
|
||||||
|
;; This functionality is applied during export as follows:
|
||||||
|
;; 1. The export feature conditions and implementations are installed
|
||||||
|
;; into the INFO plist with `org-export-install-features'.
|
||||||
|
;; This simply applies `org-export-get-all-feature-conditions' and
|
||||||
|
;; `org-export-get-all-feature-implementations', which merges the
|
||||||
|
;; backend's conditions/implementations with all of it's parents and
|
||||||
|
;; finally the global condition list
|
||||||
|
;; `org-export-conditional-features'.
|
||||||
|
;; 2. The "export features" used in a document are detected with
|
||||||
|
;; `org-export-detect-features'.
|
||||||
|
;; 3. The interaction between different feature implementations is
|
||||||
|
;; resolved with `org-export-resolve-feature-implementations',
|
||||||
|
;; producing an ordered list of implementations to be actually used
|
||||||
|
;; in an export.
|
||||||
|
;; 4. The feature implementation's snippets are transformed into strings
|
||||||
|
;; to be inserted with `org-export-expand-feature-snippets'.
|
||||||
|
|
||||||
|
(defcustom org-export-conditional-features
|
||||||
|
`(("^[ \t]*#\\+print_bibliography:" bibliography)
|
||||||
|
(,(lambda (info)
|
||||||
|
(org-element-map (plist-get info :parse-tree)
|
||||||
|
'link
|
||||||
|
(lambda (link)
|
||||||
|
(and (member (org-element-property :type link)
|
||||||
|
'("http" "https" "ftp" "file"))
|
||||||
|
(file-name-extension (org-element-property :path link))
|
||||||
|
(member (downcase (file-name-extension
|
||||||
|
(org-element-property :path link)))
|
||||||
|
image-file-name-extensions)))
|
||||||
|
info t))
|
||||||
|
image)
|
||||||
|
(,(lambda (info)
|
||||||
|
(org-element-map (plist-get info :parse-tree)
|
||||||
|
'table #'identity info t))
|
||||||
|
table)
|
||||||
|
(,(lambda (info)
|
||||||
|
(org-element-map (plist-get info :parse-tree)
|
||||||
|
'(src-block inline-src-block) #'identity info t))
|
||||||
|
code))
|
||||||
|
"Org feature tests and associated feature flags.
|
||||||
|
|
||||||
|
Alist where the car is a test for the presense of the feature,
|
||||||
|
and the CDR is either a single feature symbol or a list of
|
||||||
|
feature symbols.
|
||||||
|
|
||||||
|
See `org-export-detect-features' for how this is processed."
|
||||||
|
:group 'org-export-general
|
||||||
|
:type '(alist :key-type
|
||||||
|
(choice (regexp :tag "Feature test regexp")
|
||||||
|
(variable :tag "Feature variable")
|
||||||
|
(function :tag "Feature test function"))
|
||||||
|
:value-type
|
||||||
|
(repeat symbol :tag "Feature symbols")))
|
||||||
|
|
||||||
|
(defun org-export-detect-features (info)
|
||||||
|
"Detect features from `org-export-conditional-features' in INFO.
|
||||||
|
|
||||||
|
More specifically, for each (CONDITION . FEATURES) cons cell of
|
||||||
|
the :feature-conditions list in INFO, the CONDITION is evaluated
|
||||||
|
in two phases.
|
||||||
|
|
||||||
|
In phase one, CONDITION is transformed like so:
|
||||||
|
- If a variable symbol, the value is fetched
|
||||||
|
- If a function symbol, the function is called with INFO as the
|
||||||
|
sole argument
|
||||||
|
- If a string, passed on unmodified
|
||||||
|
|
||||||
|
In phase two, if the CONDITION result is a string, it is used as
|
||||||
|
a case-sensitive regexp search in the buffer. The regexp
|
||||||
|
matching is taken as confirmation of the existance of FEATURES.
|
||||||
|
Any other non-nil value indicates the existance of FEATURES.
|
||||||
|
|
||||||
|
A list of all detected feature symbols is returned.
|
||||||
|
|
||||||
|
This function should be run in the processed export Org buffer,
|
||||||
|
after includes have been expanded and commented trees removed."
|
||||||
|
(delete-dups
|
||||||
|
(cl-loop
|
||||||
|
for (condition . features) in (plist-get info :feature-conditions)
|
||||||
|
for matcher =
|
||||||
|
(cond
|
||||||
|
((stringp condition) condition)
|
||||||
|
((functionp condition) (funcall condition info))
|
||||||
|
((symbolp condition) (symbol-value condition))
|
||||||
|
(t (error "org-export: Feature condition %s (for %s) unable to be used"
|
||||||
|
condition features)))
|
||||||
|
for active-features =
|
||||||
|
(and (if (stringp matcher)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (point-min))
|
||||||
|
(re-search-forward matcher nil t))
|
||||||
|
matcher)
|
||||||
|
(copy-sequence features))
|
||||||
|
when active-features
|
||||||
|
nconc active-features)))
|
||||||
|
|
||||||
|
(define-error 'org-missing-feature-dependency
|
||||||
|
"A feature was asked for, but is not availible")
|
||||||
|
|
||||||
|
(define-error 'org-circular-feature-dependency
|
||||||
|
"There was a circular dependency between some features")
|
||||||
|
|
||||||
|
(defun org-export-resolve-feature-implementations (info &optional features implementations)
|
||||||
|
"Resolve the IMPLEMENTATIONS of FEATURES, of INFO.
|
||||||
|
|
||||||
|
FEATURES should be a list of all feature symbols to be resolved,
|
||||||
|
and defaults to (plist-get info :features). IMPLEMENTATIONS
|
||||||
|
should be an alist of feature symbols and specification plists,
|
||||||
|
and defaults to (plist-get info :feature-implementations).
|
||||||
|
|
||||||
|
The following keys of the each implementation plist are recognised:
|
||||||
|
- :snippet, which is either,
|
||||||
|
- A string, which should be included in the preamble verbatim.
|
||||||
|
- A variable, the value of which should be included in the preamble.
|
||||||
|
- A function, which is called with two arguments — the export info,
|
||||||
|
and the list of feature flags. The returned value is included in
|
||||||
|
the preamble.
|
||||||
|
- :requires, a feature or list of features this feature will enable.
|
||||||
|
- :when, a feature or list of features which are required for this
|
||||||
|
feature to be active.
|
||||||
|
- :prevents, a feature or list of features that should be masked.
|
||||||
|
- :order, for when inclusion order matters. Feature implementations
|
||||||
|
with a lower order appear first. The default is 0.
|
||||||
|
- :after, a feature or list of features that must be preceding.
|
||||||
|
- :before, a feature or list of features that must be succeeding.
|
||||||
|
|
||||||
|
This function processes :requires, :when, and :prevents in turn,
|
||||||
|
sorting according by :order both before processing :requires and
|
||||||
|
after processing :prevents. The final implementation list is
|
||||||
|
returned."
|
||||||
|
(let* ((explicit-features (or features (plist-get info :features)))
|
||||||
|
(implementations (or implementations
|
||||||
|
(plist-get info :feature-implementations)))
|
||||||
|
(current-implementations
|
||||||
|
(sort (cl-loop for feat in explicit-features
|
||||||
|
collect (assq feat implementations))
|
||||||
|
(lambda (a b)
|
||||||
|
(< (or (plist-get (cdr a) :order) 0)
|
||||||
|
(or (plist-get (cdr b) :order) 0)))))
|
||||||
|
;; require-records serves to record /why/ a particular implementation
|
||||||
|
;; is used. It takes the form of an alist with feature symbols as the
|
||||||
|
;; keys, and a list of features that ask for that feature as values.
|
||||||
|
;; A t value is used to indicate the feature has been explicitly
|
||||||
|
;; required.
|
||||||
|
(require-records
|
||||||
|
(cl-loop for feat in explicit-features
|
||||||
|
collect (list feat t))))
|
||||||
|
;; * Process ~:requires~
|
||||||
|
;; Here we temporarily treat current-implementations as a queue of
|
||||||
|
;; unproceesed implementations, and for each implemention move
|
||||||
|
;; it to processed-implementations if not already present.
|
||||||
|
;; :requires are processed by being added to the current-implementations
|
||||||
|
;; stack as they are seen. Along the way require-records is built for
|
||||||
|
;; the sake of the subsequent :prevents processing.
|
||||||
|
(let ((impl-queue-last (last current-implementations))
|
||||||
|
processed-implementations impl)
|
||||||
|
(while current-implementations
|
||||||
|
(setq impl (pop current-implementations))
|
||||||
|
(unless (memq impl processed-implementations)
|
||||||
|
(push impl processed-implementations)
|
||||||
|
(dolist (req (org-ensure-list
|
||||||
|
(plist-get (cdar processed-implementations) :requires)))
|
||||||
|
(unless (assq req processed-implementations)
|
||||||
|
(let ((required-impl (assq req implementations)))
|
||||||
|
(unless required-impl
|
||||||
|
(signal 'org-missing-feature-dependency
|
||||||
|
(format "The feature `%s' was asked for but could not be found"
|
||||||
|
req)))
|
||||||
|
(setq impl-queue-last
|
||||||
|
(if current-implementations
|
||||||
|
(setcdr impl-queue-last (list required-impl))
|
||||||
|
(setq current-implementations (list required-impl))))
|
||||||
|
(push (car impl) (alist-get req require-records)))))))
|
||||||
|
(setq current-implementations
|
||||||
|
(nreverse (delq nil processed-implementations))))
|
||||||
|
;; * Process ~:when~
|
||||||
|
;; More specifically, remove features with unfulfilled :when conditions.
|
||||||
|
;; To correctly resolve all the various :when conditions,
|
||||||
|
;; do not make any assumptions about which features are active.
|
||||||
|
;; Initially only consider non-:when implementations to be
|
||||||
|
;; active, then run through the list of unconfirmed :when
|
||||||
|
;; implementations and check their conditions against the list
|
||||||
|
;; of confirmed features. Continue doing this until no more
|
||||||
|
;; features are confirmed.
|
||||||
|
(let ((processing t)
|
||||||
|
(confirmed-features
|
||||||
|
(cl-remove-if ; Count unimplemented features as present.
|
||||||
|
(lambda (feat) (assq feat current-implementations))
|
||||||
|
explicit-features))
|
||||||
|
conditional-implementations when)
|
||||||
|
;; Sort all features by the presense of :when.
|
||||||
|
(dolist (impl current-implementations)
|
||||||
|
(if (plist-get (cdr impl) :when)
|
||||||
|
(push impl conditional-implementations)
|
||||||
|
(push (car impl) confirmed-features)))
|
||||||
|
(while processing
|
||||||
|
(setq processing nil)
|
||||||
|
;; Check for implementations which have satisfied :when
|
||||||
|
;; contions.
|
||||||
|
(dolist (impl conditional-implementations)
|
||||||
|
(setq when (plist-get (cdr impl) :when))
|
||||||
|
(when (cond
|
||||||
|
((symbolp when)
|
||||||
|
(memq when confirmed-features))
|
||||||
|
((consp when)
|
||||||
|
(not (cl-set-difference when confirmed-features))))
|
||||||
|
(push (car impl) confirmed-features)
|
||||||
|
(setq conditional-implementations
|
||||||
|
(delq impl conditional-implementations)
|
||||||
|
processing t))))
|
||||||
|
;; Now all that remains is implementations with unsatisfiable
|
||||||
|
;; :when conditions.
|
||||||
|
(dolist (impl conditional-implementations)
|
||||||
|
(setq current-implementations
|
||||||
|
(delq impl current-implementations))))
|
||||||
|
;; * Process ~:prevents~
|
||||||
|
;; Go through every implementation and for prevented features
|
||||||
|
;; 1. Remove them from current-implementations
|
||||||
|
;; 2. Go through require-records and remove them from the cdrs.
|
||||||
|
;; By modifying require-records in this way, features that are
|
||||||
|
;; only present due to a now-prevented feature will have a
|
||||||
|
;; nil cdr. We can then (recursively) check for these features
|
||||||
|
;; with `rassq' and remove them.
|
||||||
|
;; Since we used a queue rather than a stack when processing
|
||||||
|
;; :requires, we know that second order requires (i.e. :requires
|
||||||
|
;; of :requires) will come after after first order requires.
|
||||||
|
;; This means that should a n-th order require be prevented by
|
||||||
|
;; (n-1)-th order require, it will be removed before being
|
||||||
|
;; processed, and hence handled correctly.
|
||||||
|
(let (feats-to-remove removed null-require)
|
||||||
|
(dolist (impl current-implementations)
|
||||||
|
(setq feats-to-remove (org-ensure-list (plist-get (cdr impl) :prevents)))
|
||||||
|
(while feats-to-remove
|
||||||
|
;; Remove each of feats-to-remove.
|
||||||
|
(dolist (feat feats-to-remove)
|
||||||
|
(unless (memq feat removed)
|
||||||
|
(push feat removed)
|
||||||
|
(setq current-implementations
|
||||||
|
(delq (assq feat current-implementations)
|
||||||
|
current-implementations))
|
||||||
|
(when (assq feat require-records)
|
||||||
|
(setq require-records
|
||||||
|
(delq (assq feat require-records) require-records)))))
|
||||||
|
(dolist (rec require-records)
|
||||||
|
(setcdr rec (cl-set-difference (cdr rec) feats-to-remove)))
|
||||||
|
;; The features have now been removed.
|
||||||
|
(setq feats-to-remove nil)
|
||||||
|
;; Look for orphan requires.
|
||||||
|
(when (setq null-require (rassq nil require-records))
|
||||||
|
(push (car null-require) feats-to-remove)))))
|
||||||
|
;; Re-sort by ~:order~, to position reqirued features correctly.
|
||||||
|
(setq current-implementations
|
||||||
|
(sort current-implementations
|
||||||
|
(lambda (a b)
|
||||||
|
(< (or (plist-get (cdr a) :order) 0)
|
||||||
|
(or (plist-get (cdr b) :order) 0)))))
|
||||||
|
;; * Processing ~:before~ and ~:after~
|
||||||
|
;; To resolve dependency order, we will now perform a stable topological
|
||||||
|
;; sort on any DAGs that exist within current-implementations.
|
||||||
|
(org-export--feature-implementation-toposort
|
||||||
|
current-implementations)))
|
||||||
|
|
||||||
|
(defun org-export--feature-implementation-toposort (implementations)
|
||||||
|
"Perform a stable topological sort of IMPLEMENTATIONS.
|
||||||
|
The sort is performed based on the :before and :after properties.
|
||||||
|
|
||||||
|
See <https://en.wikipedia.org/wiki/Topological_sorting> for more information
|
||||||
|
on what this entails."
|
||||||
|
(let ((feature-indicies
|
||||||
|
(cl-loop
|
||||||
|
for elt in implementations
|
||||||
|
and index from 0
|
||||||
|
collect (cons (car elt) index)))
|
||||||
|
resolved-implementations
|
||||||
|
adj-list node-stack)
|
||||||
|
;; Build an adjacency list from :before and :after.
|
||||||
|
(dolist (impl implementations)
|
||||||
|
(push (list (car impl)) adj-list))
|
||||||
|
(dolist (impl implementations)
|
||||||
|
(let ((before (org-ensure-list (plist-get (cdr impl) :before)))
|
||||||
|
(after (org-ensure-list (plist-get (cdr impl) :after))))
|
||||||
|
(dolist (child before)
|
||||||
|
(push (car impl) (cdr (assq child adj-list))))
|
||||||
|
(when after
|
||||||
|
(setcdr (assq (car impl) adj-list)
|
||||||
|
(nconc (cdr (assq (car impl) adj-list))
|
||||||
|
after)))))
|
||||||
|
;; Initialise the node stack with the first implementation.
|
||||||
|
(setq node-stack (list (car implementations))
|
||||||
|
;; Make the order of adj-list match implementations.
|
||||||
|
adj-list
|
||||||
|
(mapcar
|
||||||
|
(lambda (entry)
|
||||||
|
(cons (car entry)
|
||||||
|
;; Sort edges according to feature order, to do
|
||||||
|
;; the DFS in order and make the result stable.
|
||||||
|
(sort (cdr entry)
|
||||||
|
(lambda (a b)
|
||||||
|
(< (or (alist-get a feature-indicies)
|
||||||
|
most-positive-fixnum)
|
||||||
|
(or (alist-get b feature-indicies)
|
||||||
|
most-positive-fixnum))))))
|
||||||
|
(nreverse adj-list)))
|
||||||
|
(while adj-list
|
||||||
|
(let ((deps (alist-get (caar node-stack) adj-list))
|
||||||
|
new-dep-found)
|
||||||
|
;; Look for any unresolved dependencies.
|
||||||
|
(while (and deps (not new-dep-found))
|
||||||
|
(if (not (assq (car deps) adj-list))
|
||||||
|
(setq deps (cdr deps))
|
||||||
|
;; Check the unresolved dependency is not part of a cycle.
|
||||||
|
(when (assq (car deps) node-stack)
|
||||||
|
(signal 'org-circular-feature-dependency
|
||||||
|
(format "Found a cycle in the feature dependency graph: %S"
|
||||||
|
(cons (car deps)
|
||||||
|
(nreverse (memq (car deps)
|
||||||
|
(nreverse
|
||||||
|
(mapcar #'car node-stack))))))))
|
||||||
|
;; Push the unresolved dependency to the top of the stack.
|
||||||
|
(push (assq (car deps) implementations)
|
||||||
|
node-stack)
|
||||||
|
(setq new-dep-found t)))
|
||||||
|
(unless new-dep-found
|
||||||
|
;; The top item of the stack has no unresolved dependencies.
|
||||||
|
;; Move it to the resolved list, and remove its entry from
|
||||||
|
;; adj-list to both mark it as such and ensure that
|
||||||
|
;; node-stack will not be incremented to it when/if the
|
||||||
|
;; stack is emptied.
|
||||||
|
(push (car node-stack) resolved-implementations)
|
||||||
|
(setq adj-list
|
||||||
|
(delq (assq (caar node-stack) adj-list) adj-list)
|
||||||
|
node-stack
|
||||||
|
(or (cdr node-stack)
|
||||||
|
(list (assq (caar adj-list) implementations)))))))
|
||||||
|
(nreverse resolved-implementations)))
|
||||||
|
|
||||||
|
(defun org-export-expand-feature-snippets (info &rest feature-implementations)
|
||||||
|
"Expand each of the feature :snippet keys in FEATURE-IMPLEMENTATIONS.
|
||||||
|
FEATURE-IMPLEMENTATIONS is expected to be a list of implementation
|
||||||
|
plists, if not provided explicitly it is extracted from the
|
||||||
|
:feature-implementations key of INFO. Note that an explicitly
|
||||||
|
provided nil FEATURE-IMPLEMENTATIONS is interpreted as no features.
|
||||||
|
|
||||||
|
Each implementation plist's :snippet value is expanded in order, in
|
||||||
|
the following manner:
|
||||||
|
- nil values are ignored
|
||||||
|
- functions are called with INFO, and must produce a string or nil
|
||||||
|
- variable symbols use the value, which must be a string or nil
|
||||||
|
- strings are included verbatim
|
||||||
|
- all other values throw an `error'.
|
||||||
|
|
||||||
|
\(fn INFO &optional FEATURE-IMPLEMENTATIONS)"
|
||||||
|
(let ((feat-impls
|
||||||
|
(cond
|
||||||
|
((not feature-implementations)
|
||||||
|
(plist-get info :feature-implementations))
|
||||||
|
((= (length feature-implementations) 1)
|
||||||
|
(car feature-implementations))
|
||||||
|
(t (signal 'wrong-number-of-arguments
|
||||||
|
`(org-export-expand-feature-snippets
|
||||||
|
,(1+ (length feature-implementations)))))))
|
||||||
|
expanded-snippets snippet value)
|
||||||
|
(dolist (impl feat-impls)
|
||||||
|
(setq snippet (plist-get (cdr impl) :snippet)
|
||||||
|
value (cond
|
||||||
|
((null snippet) nil)
|
||||||
|
((functionp snippet) (funcall snippet info))
|
||||||
|
((symbolp snippet) (symbol-value snippet))
|
||||||
|
((stringp snippet) snippet)
|
||||||
|
(t (error "org-export: The %s feature snippet %S is invalid (must be either nil, a function/variable symbol, or a string)"
|
||||||
|
(car impl) snippet))))
|
||||||
|
(cond
|
||||||
|
((stringp value)
|
||||||
|
(push value expanded-snippets))
|
||||||
|
(value ; Non-string value, could come from function or variable.
|
||||||
|
(error "org-export: The %s feature snippet %s must give nil or a string, but instead gave %S"
|
||||||
|
(car impl)
|
||||||
|
(cond
|
||||||
|
((and (functionp snippet) (symbolp snippet))
|
||||||
|
(format "function (`%s')" snippet))
|
||||||
|
((functionp snippet) "anonymous function")
|
||||||
|
(t (format "variable (`%s')" snippet)))
|
||||||
|
value))))
|
||||||
|
(nreverse expanded-snippets)))
|
||||||
|
|
||||||
|
(defun org-export-process-features (info)
|
||||||
|
"Install feature conditions/implementations in INFO, and resolve them.
|
||||||
|
See `org-export-detect-features' and `org-export-resolve-feature-implementations' for
|
||||||
|
more information on what this entails."
|
||||||
|
(org-export-install-features info)
|
||||||
|
(let* ((exp-features (org-export-detect-features info))
|
||||||
|
(resolved-implementations
|
||||||
|
(org-export-resolve-feature-implementations info exp-features)))
|
||||||
|
(plist-put info :feature-implementations resolved-implementations)
|
||||||
|
(plist-put info :features (mapcar #'car resolved-implementations))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defmacro org-export-update-features (backend &rest feature-property-value-lists)
|
||||||
|
"For BACKEND's export spec, set each FEATURE's :PROPERTY to VALUE.
|
||||||
|
|
||||||
|
The behaviour of this macro is best behaved with an example.
|
||||||
|
For instance, to add some preamble content from the variable
|
||||||
|
\"my-org-beamer-metropolis-tweaks\" when using the metropolis theme
|
||||||
|
with beamer export:
|
||||||
|
|
||||||
|
(org-export-update-features \\='beamer
|
||||||
|
(beamer-metropolis
|
||||||
|
:condition (string-match-p \"metropolis$\" (plist-get info :beamer-theme))
|
||||||
|
:snippet my-org-beamer-metropolis-tweaks
|
||||||
|
:order 3))
|
||||||
|
|
||||||
|
The modifies the beamer backend, either creating or updating the
|
||||||
|
\"beamer-metropolis\" feature. The :condition property adds a
|
||||||
|
condition which detects the feature, and all other properties are
|
||||||
|
applied to the feature's implementation plist. Setting
|
||||||
|
:condition to t means the feature will always be enabled, and
|
||||||
|
conversely setting :condition to nil means the feature will never
|
||||||
|
be enabled.
|
||||||
|
|
||||||
|
When setting the :condition and :snippet properties, any sexp is
|
||||||
|
is implicitly converted to,
|
||||||
|
(lambda (info) SEXPR)
|
||||||
|
|
||||||
|
Each (FEATURE . (:PROPERTY VALUE)) form that is processed is
|
||||||
|
taken from the single &rest argument
|
||||||
|
FEATURE-PROPERTY-VALUE-LISTS.
|
||||||
|
|
||||||
|
\(fn BACKEND &rest (FEATURE . (:PROPERTY VALUE)...)...)"
|
||||||
|
(declare (indent 1))
|
||||||
|
(org-with-gensyms (backend-struct the-entry the-condition the-feat-impl cond-feat)
|
||||||
|
(let ((backend-expr
|
||||||
|
(if (and (eq (car-safe backend) 'quote)
|
||||||
|
(symbolp (cadr backend))
|
||||||
|
(not (cddr backend)))
|
||||||
|
`(org-export-get-backend ',(cadr backend))
|
||||||
|
`(if (symbolp ,backend)
|
||||||
|
(org-export-get-backend ,backend)
|
||||||
|
backend)))
|
||||||
|
(backend-impls
|
||||||
|
(list 'aref backend-struct
|
||||||
|
(cl-struct-slot-offset 'org-export-backend 'feature-implementations)))
|
||||||
|
(backend-conds
|
||||||
|
(list 'aref backend-struct
|
||||||
|
(cl-struct-slot-offset 'org-export-backend 'feature-conditions)))
|
||||||
|
body condition-set-p implementation-set-p)
|
||||||
|
(dolist (feature-property-value-set feature-property-value-lists)
|
||||||
|
(when (eq (car feature-property-value-set) 'quote)
|
||||||
|
(pop feature-property-value-set))
|
||||||
|
(let ((features (car feature-property-value-set))
|
||||||
|
(property-value-pairs (cdr feature-property-value-set))
|
||||||
|
let-body property value)
|
||||||
|
(while property-value-pairs
|
||||||
|
(setq property (pop property-value-pairs)
|
||||||
|
value (pop property-value-pairs))
|
||||||
|
(cond
|
||||||
|
((consp value)
|
||||||
|
(unless (memq (car value) '(function quote))
|
||||||
|
(if (and (memq property '(:condition :snippet))
|
||||||
|
(not (functionp value)))
|
||||||
|
(setq value `(lambda (info) ,value))
|
||||||
|
(setq value (list 'quote value)))))
|
||||||
|
((memq value '(nil t))) ; Leave unmodified.
|
||||||
|
((symbolp value)
|
||||||
|
(setq value (list 'quote value))))
|
||||||
|
(if (eq property :condition)
|
||||||
|
(progn
|
||||||
|
(unless condition-set-p
|
||||||
|
(setq condition-set-p t))
|
||||||
|
(push
|
||||||
|
(if value
|
||||||
|
(let ((the-features (org-ensure-list features)))
|
||||||
|
`(let* ((,the-condition ,value)
|
||||||
|
(,the-entry (assoc ,the-condition ,backend-conds)))
|
||||||
|
(if ,the-entry
|
||||||
|
(setcdr ,the-entry
|
||||||
|
(append ',the-features (cdr ,the-entry)))
|
||||||
|
(push (cons ,the-condition ',the-features)
|
||||||
|
,backend-conds))))
|
||||||
|
(let ((single-feature
|
||||||
|
(if (consp features)
|
||||||
|
(intern (string-join (mapcar #'symbol-name features)
|
||||||
|
"-and-"))
|
||||||
|
features)))
|
||||||
|
`(dolist (,cond-feat ,backend-conds)
|
||||||
|
(cond
|
||||||
|
((equal (cdr ,cond-feat) (list ',single-feature))
|
||||||
|
(setf ,backend-conds (delq ,cond-feat ,backend-conds)))
|
||||||
|
((memq ',single-feature (cdr ,cond-feat))
|
||||||
|
(setcdr ,cond-feat
|
||||||
|
(delq ',single-feature (cdr ,cond-feat))))))))
|
||||||
|
body))
|
||||||
|
(unless implementation-set-p
|
||||||
|
(setq implementation-set-p t))
|
||||||
|
(push
|
||||||
|
(if let-body
|
||||||
|
`(plist-put (cdr ,the-feat-impl) ,property ,value)
|
||||||
|
`(setcdr ,the-feat-impl
|
||||||
|
(plist-put (cdr ,the-feat-impl) ,property ,value)))
|
||||||
|
let-body)))
|
||||||
|
(when let-body
|
||||||
|
(let ((the-feature
|
||||||
|
(if (consp features)
|
||||||
|
(intern (string-join (mapcar #'symbol-name features)
|
||||||
|
"-and-"))
|
||||||
|
features)))
|
||||||
|
(when (consp features)
|
||||||
|
(push
|
||||||
|
`(plist-put (cdr ,the-feat-impl) :when ',features)
|
||||||
|
let-body))
|
||||||
|
(push
|
||||||
|
`(let ((,the-feat-impl
|
||||||
|
(or (assoc ',the-feature ,backend-impls)
|
||||||
|
(car (push (list ',the-feature ,property nil)
|
||||||
|
,backend-impls)))))
|
||||||
|
,@(nreverse let-body))
|
||||||
|
body)))))
|
||||||
|
`(let ((,backend-struct ,backend-expr))
|
||||||
|
,@(and (not (org-export-backend-p backend-expr))
|
||||||
|
`((unless (org-export-backend-p ,backend-struct)
|
||||||
|
(error "`%s' is not a loaded export backend" ,backend))))
|
||||||
|
,@(nreverse body)
|
||||||
|
nil))))
|
||||||
|
|
||||||
|
|
||||||
;;; The Filter System
|
;;; The Filter System
|
||||||
|
@ -3129,6 +3737,8 @@ still inferior to file-local settings."
|
||||||
(when (plist-get info :with-cite-processors)
|
(when (plist-get info :with-cite-processors)
|
||||||
(org-cite-process-citations info)
|
(org-cite-process-citations info)
|
||||||
(org-cite-process-bibliography info))
|
(org-cite-process-bibliography info))
|
||||||
|
;; Install all the feature conditions and implementations.
|
||||||
|
(org-export-process-features info)
|
||||||
info))
|
info))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
|
|
Loading…
Reference in New Issue