[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[O] [RFC] Changing internal representation of back-ends to defstructs
|
From: |
Nicolas Goaziou |
|
Subject: |
[O] [RFC] Changing internal representation of back-ends to defstructs |
|
Date: |
Wed, 03 Jul 2013 22:57:58 +0200 |
Hello,
Currently, a back-end is a symbol which may point to an entry in
`org-export-registered-backends' variable. Therefore a back-end must be
registered (with a unique name) before one can call it. Or, to put it
differently, it is impossible to use an anonymous and temporary
back-end.
This is not satisfying for developers, as there are situations when you
need to use a one-shot back-end but don't want to clutter registered
back-ends list. You can of course let-bind
`org-export-registered-backends' to something else, but it leads to
clunky code. The process should be abstracted a bit more.
The following (long) patches address this by defining back-ends as
structures (see `defstruct'), possibly anonymous and by separating
creation from registration process. It allows to quickly create and use
temporary back-ends. In the example below, we quickly export a string
using a temporary back-end:
(org-export-string-as
"* H1\n** H2\nSome string"
(org-export-create-backend
:transcoders
'((headline . (lambda (h contents i)
(let ((m (make-string (org-export-get-relative-level h i)
?=)))
(concat m " " (org-element-property :raw-value h) " " m
"\n"
contents))))
;; Contents only.
(section . (lambda (e c i) c))
(paragraph . (lambda (e c i) c)))))
It is also possible to create a temporary derived back-end. The
following export will use registered `latex' back-end, excepted for
`bold' type objects.
(org-export-string-as
"Some *bold* /string/"
(org-export-create-backend
:parent 'latex
:transcoders '((italic . (lambda (o c i) (format "\\texit{%s}" c)))))
'body-only)
Besides `org-export-create-backend', tools provided are:
- `org-export-get-backend'
- `org-export-register-backend'
- `org-export-get-all-transcoders' (handles inheritance)
- `org-export-get-all-options' (handles inheritance)
- `org-export-get-all-filters' (handles inheritance)
At a higher level, `org-export-define-backend' and
`org-export-define-derived-backend' do not change (they are equivalent
to create and register in a row). So this change only matters for
back-end developers who used advanced features like
`org-export-with-translations' (which should now be
`org-export-with-backend' coupled with an anonymous back-end).
Also, it leads to a cleaner implementation as it removes the confusion
between a back-end and its name.
The next step after applying this patch will be to make
orgtbl-to-BACKEND functions use anonymous functions in order to
support :splice property, which is tedious with the new export
framework.
Feedback welcome.
Regards,
--
Nicolas Goaziou
>From 35bf951a1cd4c455f01863e128a899d36e76a76c Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <address@hidden>
Date: Mon, 24 Jun 2013 20:52:10 +0200
Subject: [PATCH 1/2] ox: Change back-ends internal representation to
structures
* lisp/ox.el (org-export--registered-backends): Renamed from
`org-export-registered-backends'.
(org-export-invisible-backends): Removed variable.
(org-export-get-backend, org-export-get-all-transcoders
org-export-get-all-options, org-export-get-all-filters): New
functions. It replaces `org-export-backend-translate-table'.
(org-export-barf-if-invalid-backend, org-export-derived-backend-p,
org-export-define-backend, org-export-define-derived-backend):
Rewrite functions using new representation.
(org-export-backend-translate-table): Remove function.
(org-export-get-environment): Use new function.
(org-export--get-subtree-options, org-export--parse-option-keyword,
org-export--get-inbuffer-options, org-export--get-global-options,
org-export-to-buffer org-export-to-file, org-export-string-as
org-export-replace-region-by): Update docstring.
(org-export-data-with-translations): Remove function. Use
`org-export-data-with-backend' with a temporary back-end instead.
(org-export-data-with-backend, org-export-as): Reflect new definition
for back-ends.
(org-export--dispatch-action, org-export--dispatch-ui): Reflect new
definition for back-ends and variable removal. Refactoring.
(org-export-filter-apply-functions): Call functions with
current back-end's name, not full back-end.
* lisp/org.el (org-export-backends, org-create-formula--latex-header):
Use new structure and variables.
* testing/lisp/test-ox.el: Update tests.
This patch separates back-end definition from its registration. Thus,
it allows to use anonymous or unregistered back-ends.
---
lisp/org.el | 58 ++--
lisp/ox.el | 527 +++++++++++++++++---------------
testing/lisp/test-ox.el | 781 +++++++++++++++++++++++++++---------------------
3 files changed, 764 insertions(+), 602 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index 6233972..89cc328 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -436,8 +436,9 @@ For export specific modules, see also
`org-export-backends'."
(const :tag "C wl: Links to Wanderlust
folders/messages" org-wl)
(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
-(defvar org-export-registered-backends) ; From ox.el
+(defvar org-export--registered-backends) ; From ox.el.
(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
+(declare-function org-export-backend-name "ox" (backend))
(defcustom org-export-backends '(ascii html icalendar latex)
"List of export back-ends that should be always available.
@@ -451,30 +452,29 @@ needed.
This variable needs to be set before org.el is loaded. If you
need to make a change while Emacs is running, use the customize
-interface or run the following code, where VALUE stands for the
-new value of the variable, after updating it:
+interface or run the following code, where VAL stands for the new
+value of the variable, after updating it:
\(progn
- \(setq org-export-registered-backends
+ \(setq org-export--registered-backends
\(org-remove-if-not
\(lambda (backend)
- \(or (memq backend val)
- \(catch 'parentp
- \(mapc
- \(lambda (b)
- \(and (org-export-derived-backend-p b (car backend))
- \(throw 'parentp t)))
- val)
- nil)))
- org-export-registered-backends))
- \(let ((new-list (mapcar 'car org-export-registered-backends)))
+ \(let ((name (org-export-backend-name backend)))
+ \(or (memq name val)
+ \(catch 'parentp
+ \(dolist (b val)
+ \(and (org-export-derived-backend-p b name)
+ \(throw 'parentp t)))))))
+ org-export--registered-backends))
+ \(let ((new-list (mapcar 'org-export-backend-name
+ org-export--registered-backends)))
\(dolist (backend val)
\(cond
\((not (load (format \"ox-%s\" backend) t t))
\(message \"Problems while trying to load export back-end `%s'\"
backend))
\((not (memq backend new-list)) (push backend new-list))))
- \(set-default var new-list)))
+ \(set-default 'org-export-backends new-list)))
Adding a back-end to this list will also pull the back-end it
depends on, if any."
@@ -488,21 +488,20 @@ depends on, if any."
;; Any back-end not required anymore (not present in VAL and not
;; a parent of any back-end in the new value) is removed from the
;; list of registered back-ends.
- (setq org-export-registered-backends
+ (setq org-export--registered-backends
(org-remove-if-not
(lambda (backend)
- (or (memq backend val)
- (catch 'parentp
- (mapc
- (lambda (b)
- (and (org-export-derived-backend-p b (car backend))
- (throw 'parentp t)))
- val)
- nil)))
- org-export-registered-backends))
+ (let ((name (org-export-backend-name backend)))
+ (or (memq name val)
+ (catch 'parentp
+ (dolist (b val)
+ (and (org-export-derived-backend-p b name)
+ (throw 'parentp t)))))))
+ org-export--registered-backends))
;; Now build NEW-LIST of both new back-ends and required
;; parents.
- (let ((new-list (mapcar 'car org-export-registered-backends)))
+ (let ((new-list (mapcar 'org-export-backend-name
+ org-export--registered-backends)))
(dolist (backend val)
(cond
((not (load (format "ox-%s" backend) t t))
@@ -18494,14 +18493,17 @@ share a good deal of logic."
"Invalid value of `org-latex-create-formula-image-program'")))
string tofile options buffer))
+(declare-function org-export-get-backend "ox" (name))
(declare-function org-export--get-global-options "ox" (&optional backend))
(declare-function org-export--get-inbuffer-options "ox" (&optional backend))
(declare-function org-latex-guess-inputenc "ox-latex" (header))
(declare-function org-latex-guess-babel-language "ox-latex" (header info))
(defun org-create-formula--latex-header ()
"Return LaTeX header appropriate for previewing a LaTeX snippet."
- (let ((info (org-combine-plists (org-export--get-global-options 'latex)
- (org-export--get-inbuffer-options 'latex))))
+ (let ((info (org-combine-plists (org-export--get-global-options
+ (org-export-get-backend 'latex))
+ (org-export--get-inbuffer-options
+ (org-export-get-backend 'latex)))))
(org-latex-guess-babel-language
(org-latex-guess-inputenc
(org-splice-latex-header
diff --git a/lisp/ox.el b/lisp/ox.el
index 92ad356..71435b7 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -47,15 +47,10 @@
;; The core function is `org-export-as'. It returns the transcoded
;; buffer as a string.
;;
-;; An export back-end is defined with `org-export-define-backend',
-;; which defines one mandatory information: his translation table.
-;; Its value is an alist whose keys are elements and objects types and
-;; values translator functions. See function's docstring for more
-;; information about translators.
-;;
-;; Optionally, `org-export-define-backend' can also support specific
-;; buffer keywords, OPTION keyword's items and filters. Also refer to
-;; function documentation for more information.
+;; 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
@@ -280,14 +275,8 @@ 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
+(defvar org-export--registered-backends nil
"List of backends currently available in the exporter.
-
-A backend is stored as a list where CAR is its name, as a symbol,
-and CDR is a plist with the following properties:
-`:filters-alist', `:menu-entry', `:options-alist' and
-`:translate-alist'.
-
This variable is set with `org-export-define-backend' and
`org-export-define-derived-backend' functions.")
@@ -830,20 +819,6 @@ process faster and the export more portable."
:package-version '(Org . "8.0")
:type '(file :must-match t))
-(defcustom org-export-invisible-backends nil
- "List of back-ends that shouldn't appear in the dispatcher.
-
-Any back-end belonging to this list or derived from a back-end
-belonging to it will not appear in the dispatcher menu.
-
-Indeed, Org may require some export back-ends without notice. If
-these modules are never to be used interactively, adding them
-here will avoid cluttering the dispatcher menu."
- :group 'org-export-general
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(repeat (symbol :tag "Back-End")))
-
(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
@@ -863,25 +838,147 @@ mode."
;;; Defining Back-ends
;;
-;; `org-export-define-backend' is the standard way to define an export
-;; back-end. It allows to specify translators, filters, buffer
-;; options and a menu entry. If the new back-end shares translators
-;; with another back-end, `org-export-define-derived-backend' may be
-;; used instead.
+;; 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.
;;
-;; Internally, a back-end is stored as a list, of which CAR is the
-;; name of the back-end, as a symbol, and CDR a plist. Accessors to
-;; properties of a given back-end are: `org-export-backend-filters',
-;; `org-export-backend-menu', `org-export-backend-options' and
-;; `org-export-backend-translate-table'.
+;; 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.
-(defun org-export-define-backend (backend translators &rest body)
+(defstruct (org-export-backend (:constructor org-export-create-backend)
+ (:copier nil))
+ name parent transcoders options filters blocks menu)
+
+(defun org-export-get-backend (name)
+ "Return export back-end named after NAME.
+NAME is a symbol. Return nil if no such back-end is found."
+ (catch 'found
+ (dolist (b org-export--registered-backends)
+ (when (eq (org-export-backend-name b) name)
+ (throw 'found b)))))
+
+(defun org-export-register-backend (backend)
+ "Register BACKEND as a known export back-end.
+BACKEND is a structure with `org-export-backend' type."
+ ;; Refuse to register an unnamed back-end.
+ (unless (org-export-backend-name backend)
+ (error "Cannot register a unnamed export back-end"))
+ ;; Refuse to register a back-end with an unknown parent.
+ (let ((parent (org-export-backend-parent backend)))
+ (when (and parent (not (org-export-get-backend parent)))
+ (error "Cannot use unknown \"%s\" back-end as a parent" parent)))
+ ;; Register dedicated export blocks in the parser.
+ (dolist (name (org-export-backend-blocks backend))
+ (add-to-list 'org-element-block-name-alist
+ (cons name 'org-element-export-block-parser)))
+ ;; If a back-end with the same name as BACKEND is already
+ ;; registered, replace it with BACKEND. Otherwise, simply add
+ ;; BACKEND to the list of registered back-ends.
+ (let ((old (org-export-get-backend (org-export-backend-name backend))))
+ (if old (setcar (memq old org-export--registered-backends) backend)
+ (push backend org-export--registered-backends))))
+
+(defun org-export-barf-if-invalid-backend (backend)
+ "Signal an error if BACKEND isn't defined."
+ (unless (org-export-backend-p backend)
+ (error "Unknown \"%s\" back-end: Aborting export" backend)))
+
+(defun org-export-derived-backend-p (backend &rest backends)
+ "Non-nil if BACKEND is derived from one of BACKENDS.
+BACKEND is an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. BACKENDS is constituted of symbols."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (catch 'exit
+ (while (org-export-backend-parent backend)
+ (when (memq (org-export-backend-name backend) backends)
+ (throw 'exit t))
+ (setq backend
+ (org-export-get-backend (org-export-backend-parent backend))))
+ (memq (org-export-backend-name backend) backends))))
+
+(defun org-export-get-all-transcoders (backend)
+ "Return full translation table for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. Return value is an alist where
+keys are element or object types, as symbols, and values are
+transcoders.
+
+Unlike to `org-export-backend-transcoders', this function
+also returns transcoders inherited from parent back-ends,
+if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((transcoders (org-export-backend-transcoders backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq transcoders
+ (append transcoders (org-export-backend-transcoders backend))))
+ transcoders)))
+
+(defun org-export-get-all-options (backend)
+ "Return export options for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. See `org-export-options-alist'
+for the shape of the return value.
+
+Unlike to `org-export-backend-options', this function also
+returns options inherited from parent back-ends, if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((options (org-export-backend-options backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq options (append options (org-export-backend-options backend))))
+ options)))
+
+(defun org-export-get-all-filters (backend)
+ "Return complete list of filters for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. Return value is an alist where
+keys are symbols and values lists of functions.
+
+Unlike to `org-export-backend-filters', this function also
+returns filters inherited from parent back-ends, if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((filters (org-export-backend-filters backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq filters (append filters (org-export-backend-filters backend))))
+ filters)))
+
+(defun org-export-define-backend (backend transcoders &rest body)
"Define a new back-end BACKEND.
-TRANSLATORS is an alist between object or element types and
+TRANSCODERS is an alist between object or element types and
functions handling them.
These functions should return a string without any trailing
@@ -997,32 +1094,23 @@ keywords are understood:
`org-export-options-alist' for more information about
structure of the values."
(declare (indent 1))
- (let (export-block filters menu-entry options contents)
+ (let (blocks filters menu-entry options contents)
(while (keywordp (car body))
(case (pop body)
(:export-block (let ((names (pop body)))
- (setq export-block
- (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
(:filters-alist (setq filters (pop body)))
(:menu-entry (setq menu-entry (pop body)))
(:options-alist (setq options (pop body)))
(t (pop body))))
- (setq contents (append (list :translate-alist translators)
- (and filters (list :filters-alist filters))
- (and options (list :options-alist options))
- (and menu-entry (list :menu-entry menu-entry))))
- ;; Register back-end.
- (let ((registeredp (assq backend org-export-registered-backends)))
- (if registeredp (setcdr registeredp contents)
- (push (cons backend contents) org-export-registered-backends)))
- ;; Tell parser to not parse EXPORT-BLOCK blocks.
- (when export-block
- (mapc
- (lambda (name)
- (add-to-list 'org-element-block-name-alist
- `(,name . org-element-export-block-parser)))
- export-block))))
+ (org-export-register-backend
+ (org-export-create-backend :name backend
+ :transcoders transcoders
+ :options options
+ :filters filters
+ :blocks blocks
+ :menu menu-entry))))
(defun org-export-define-derived-backend (child parent &rest body)
"Create a new back-end as a variant of an existing one.
@@ -1077,75 +1165,25 @@ The back-end could then be called with, for example:
\(org-export-to-buffer 'my-latex \"*Test my-latex*\")"
(declare (indent 2))
- (let (export-block filters menu-entry options translators contents)
+ (let (blocks filters menu-entry options transcoders contents)
(while (keywordp (car body))
(case (pop body)
(:export-block (let ((names (pop body)))
- (setq export-block
- (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
(:filters-alist (setq filters (pop body)))
(:menu-entry (setq menu-entry (pop body)))
(:options-alist (setq options (pop body)))
- (:translate-alist (setq translators (pop body)))
+ (:translate-alist (setq transcoders (pop body)))
(t (pop body))))
- (setq contents (append
- (list :parent parent)
- (let ((p-table (org-export-backend-translate-table parent)))
- (list :translate-alist (append translators p-table)))
- (let ((p-filters (org-export-backend-filters parent)))
- (list :filters-alist (append filters p-filters)))
- (let ((p-options (org-export-backend-options parent)))
- (list :options-alist (append options p-options)))
- (and menu-entry (list :menu-entry menu-entry))))
- (org-export-barf-if-invalid-backend parent)
- ;; Register back-end.
- (let ((registeredp (assq child org-export-registered-backends)))
- (if registeredp (setcdr registeredp contents)
- (push (cons child contents) org-export-registered-backends)))
- ;; Tell parser to not parse EXPORT-BLOCK blocks.
- (when export-block
- (mapc
- (lambda (name)
- (add-to-list 'org-element-block-name-alist
- `(,name . org-element-export-block-parser)))
- export-block))))
-
-(defun org-export-backend-parent (backend)
- "Return back-end from which BACKEND is derived, or nil."
- (plist-get (cdr (assq backend org-export-registered-backends)) :parent))
-
-(defun org-export-backend-filters (backend)
- "Return filters for BACKEND."
- (plist-get (cdr (assq backend org-export-registered-backends))
- :filters-alist))
-
-(defun org-export-backend-menu (backend)
- "Return menu entry for BACKEND."
- (plist-get (cdr (assq backend org-export-registered-backends))
- :menu-entry))
-
-(defun org-export-backend-options (backend)
- "Return export options for BACKEND."
- (plist-get (cdr (assq backend org-export-registered-backends))
- :options-alist))
-
-(defun org-export-backend-translate-table (backend)
- "Return translate table for BACKEND."
- (plist-get (cdr (assq backend org-export-registered-backends))
- :translate-alist))
-
-(defun org-export-barf-if-invalid-backend (backend)
- "Signal an error if BACKEND isn't defined."
- (unless (org-export-backend-translate-table backend)
- (error "Unknown \"%s\" back-end: Aborting export" backend)))
-
-(defun org-export-derived-backend-p (backend &rest backends)
- "Non-nil if BACKEND is derived from one of BACKENDS."
- (let ((parent backend))
- (while (and (not (memq parent backends))
- (setq parent (org-export-backend-parent parent))))
- parent))
+ (org-export-register-backend
+ (org-export-create-backend :name child
+ :parent parent
+ :transcoders transcoders
+ :options options
+ :filters filters
+ :blocks blocks
+ :menu menu-entry))))
@@ -1448,14 +1486,15 @@ The back-end could then be called with, for example:
;; `org-export--get-subtree-options' and
;; `org-export--get-inbuffer-options'
;;
-;; Also, `org-export--install-letbind-maybe' takes care of the part
-;; relative to "#+BIND:" keywords.
+;; Also, `org-export--list-bound-variables' collects bound variables
+;; along with their value in order to set them as buffer local
+;; variables later in the process.
(defun org-export-get-environment (&optional backend subtreep ext-plist)
"Collect export options from the current buffer.
-Optional argument BACKEND is a symbol specifying which back-end
-specific options to read, if any.
+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.
@@ -1481,8 +1520,7 @@ inferior to file-local settings."
(list
:back-end
backend
- :translate-alist
- (org-export-backend-translate-table backend)
+ :translate-alist (org-export-get-all-transcoders backend)
:footnote-definition-alist
;; Footnotes definitions must be collected in the original
;; buffer, as there's no insurance that they will still be in
@@ -1518,11 +1556,12 @@ inferior to file-local settings."
(defun org-export--parse-option-keyword (options &optional backend)
"Parse an OPTIONS line and return values as a plist.
-Optional argument BACKEND is a symbol specifying which back-end
+Optional argument BACKEND is an export back-end, as returned by,
+e.g., `org-export-create-backend'. It specifies which back-end
specific items to read, if any."
(let* ((all
;; Priority is given to back-end specific options.
- (append (and backend (org-export-backend-options backend))
+ (append (and backend (org-export-get-all-options backend))
org-export-options-alist))
plist)
(dolist (option all)
@@ -1542,7 +1581,8 @@ specific items to read, if any."
(defun org-export--get-subtree-options (&optional backend)
"Get export options in subtree at point.
-Optional argument BACKEND is a symbol specifying back-end used
+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
@@ -1594,7 +1634,7 @@ for export. Return options as a plist."
(t value)))))))))
;; Look for both general keywords and back-end specific
;; options, with priority given to the latter.
- (append (and backend (org-export-backend-options backend))
+ (append (and backend (org-export-get-all-options backend))
org-export-options-alist)))
;; Return value.
plist)))
@@ -1602,7 +1642,8 @@ for export. Return options as a plist."
(defun org-export--get-inbuffer-options (&optional backend)
"Return current buffer export options, as a plist.
-Optional argument BACKEND, when non-nil, is a symbol specifying
+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.
@@ -1612,7 +1653,7 @@ Assume buffer is in Org mode. Narrowing, if any, is
ignored."
(case-fold-search t)
(options (append
;; Priority is given to back-end specific options.
- (and backend (org-export-backend-options backend))
+ (and backend (org-export-get-all-options backend))
org-export-options-alist))
(regexp (format "^[ \t]*#\\+%s:"
(regexp-opt (nconc (delq nil (mapcar 'cadr options))
@@ -1725,12 +1766,13 @@ name."
(defun org-export--get-global-options (&optional backend)
"Return global export options as a plist.
-Optional argument BACKEND, if non-nil, is a symbol specifying
+Optional argument BACKEND, if non-nil, is an export back-end, as
+returned by, e.g., `org-export-create-backend'. It specifies
which back-end specific export options should also be read in the
process."
(let (plist
;; Priority is given to back-end specific options.
- (all (append (and backend (org-export-backend-options backend))
+ (all (append (and backend (org-export-get-all-options backend))
org-export-options-alist)))
(dolist (cell all plist)
(let ((prop (car cell)))
@@ -2058,11 +2100,10 @@ a tree with a select tag."
;; back-end output. It takes care of filtering out elements or
;; objects according to export options and organizing the output blank
;; lines and white space are preserved. The function memoizes its
-;; results, so it is cheap to call it within translators.
+;; 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-translations' and
;; `org-export-data-with-backend'.
;;
;; Internally, three functions handle the filtering of objects and
@@ -2190,24 +2231,6 @@ Return transcoded string."
results)))
(plist-get info :exported-data))))))
-(defun org-export-data-with-translations (data translations info)
- "Convert DATA into another format using a given translation table.
-DATA is an element, an object, a secondary string or a string.
-TRANSLATIONS is an alist between element or object types and
-a functions handling them. See `org-export-define-backend' for
-more information. INFO is a plist used as a communication
-channel."
- (org-export-data
- data
- ;; Set-up a new communication channel with TRANSLATIONS as the
- ;; translate table and a new hash table for memoization.
- (org-combine-plists
- info
- (list :translate-alist translations
- ;; Size of the hash table is reduced since this function
- ;; will probably be used on short trees.
- :exported-data (make-hash-table :test 'eq :size 401)))))
-
(defun org-export-data-with-backend (data backend info)
"Convert DATA into BACKEND format.
@@ -2217,9 +2240,18 @@ channel.
Unlike to `org-export-with-backend', this function will
recursively convert DATA using BACKEND translation table."
- (org-export-barf-if-invalid-backend backend)
- (org-export-data-with-translations
- data (org-export-backend-translate-table backend) info))
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-data
+ data
+ ;; Set-up a new communication channel with translations defined in
+ ;; BACKEND as the translate table and a new hash table for
+ ;; memoization.
+ (org-combine-plists
+ info
+ (list :translate-alist (org-export-get-all-transcoders backend)
+ ;; Size of the hash table is reduced since this function
+ ;; will probably be used on short trees.
+ :exported-data (make-hash-table :test 'eq :size 401)))))
(defun org-export--interpret-p (blob info)
"Non-nil if element or object BLOB should be interpreted during export.
@@ -2713,18 +2745,19 @@ channel, as a plist. It must return a string or nil.")
"Call every function in FILTERS.
Functions are called with arguments VALUE, current export
-back-end and INFO. A function returning a nil value will be
-skipped. If it returns the empty string, the process ends and
+back-end's name and INFO. A function returning a nil value will
+be skipped. If it returns the empty string, the process ends and
VALUE is ignored.
Call is done in a LIFO fashion, to be sure that developer
specified filters, if any, are called first."
(catch 'exit
- (dolist (filter filters value)
- (let ((result (funcall filter value (plist-get info :back-end) info)))
- (cond ((not result) value)
- ((equal value "") (throw 'exit nil))
- (t (setq value result)))))))
+ (let ((backend-name (plist-get info :back-end)))
+ (dolist (filter filters value)
+ (let ((result (funcall filter value backend-name info)))
+ (cond ((not result) value)
+ ((equal value "") (throw 'exit nil))
+ (t (setq value result))))))))
(defun org-export-install-filters (info)
"Install filters properties in communication channel.
@@ -2755,7 +2788,7 @@ Return the updated communication channel."
plist key
(if (atom value) (cons value (plist-get plist key))
(append value (plist-get plist key))))))))
- (org-export-backend-filters (plist-get info :back-end)))
+ (org-export-get-all-filters (plist-get info :back-end)))
;; Return new communication channel.
(org-combine-plists info plist)))
@@ -2891,6 +2924,10 @@ The function assumes BUFFER's major mode is `org-mode'."
(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.
@@ -2911,6 +2948,7 @@ 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
@@ -2943,8 +2981,9 @@ Return code as a string."
;; created, where include keywords, macros are expanded and
;; code blocks are evaluated.
(org-export-with-buffer-copy
- ;; Run first hook with current back-end as argument.
- (run-hook-with-args 'org-export-before-processing-hook backend)
+ ;; Run first hook with current back-end's name as argument.
+ (run-hook-with-args 'org-export-before-processing-hook
+ (org-export-backend-name backend))
(org-export-expand-include-keyword)
;; Update macro templates since #+INCLUDE keywords might have
;; added some new ones.
@@ -2954,10 +2993,11 @@ Return code as a string."
;; Update radio targets since keyword inclusion might have
;; added some more.
(org-update-radio-target-regexp)
- ;; Run last hook with current back-end as argument.
+ ;; Run last hook with current back-end's name as argument.
(goto-char (point-min))
(save-excursion
- (run-hook-with-args 'org-export-before-parsing-hook backend))
+ (run-hook-with-args 'org-export-before-parsing-hook
+ (org-export-backend-name backend)))
;; Update communication channel with environment. Also
;; install user's and developer's filters.
(setq info
@@ -2980,9 +3020,10 @@ Return code as a string."
;; 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.
- (dolist (filter (plist-get info :filter-options))
- (let ((result (funcall filter info backend)))
- (when result (setq info result))))
+ (let ((backend-name (org-export-backend-name backend)))
+ (dolist (filter (plist-get info :filter-options))
+ (let ((result (funcall filter info backend-name)))
+ (when result (setq info result)))))
;; Parse buffer and call parse-tree filter on it.
(setq tree
(org-export-filter-apply-functions
@@ -3018,7 +3059,9 @@ Return code as a string."
(backend buffer &optional subtreep visible-only body-only ext-plist)
"Call `org-export-as' with output to a specified buffer.
-BACKEND is the back-end used for transcoding, as a symbol.
+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 output buffer. If it already exists, it will be
erased first, otherwise, it will be created.
@@ -3046,8 +3089,10 @@ to kill ring. Return buffer."
(backend file &optional subtreep visible-only body-only ext-plist)
"Call `org-export-as' with output to a specified file.
-BACKEND is the back-end used for transcoding, as a symbol. FILE
-is the name of the output file, as a string.
+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.
Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
EXT-PLIST are similar to those used in `org-export-as', which
@@ -3074,6 +3119,10 @@ to kill ring. Return output file's name."
(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.
@@ -3089,7 +3138,10 @@ Return code as a string."
;;;###autoload
(defun org-export-replace-region-by (backend)
- "Replace the active region by its export to BACKEND."
+ "Replace the active region by its export to BACKEND.
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end."
(if (not (org-region-active-p))
(user-error "No active region to replace")
(let* ((beg (region-beginning))
@@ -3103,10 +3155,10 @@ Return code as a string."
(defun org-export-insert-default-template (&optional backend subtreep)
"Insert all export keywords with default values at beginning of line.
-BACKEND is a symbol representing the 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.
+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."
@@ -3115,17 +3167,22 @@ locally for the subtree through node properties."
(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 (car b)))
- org-export-registered-backends))))))
+ (backend
+ (or backend
+ (intern
+ (org-completing-read
+ "Options category: "
+ (cons "default"
+ (mapcar (lambda (b)
+ (symbol-name (org-export-backend-name b)))
+ org-export--registered-backends))))))
options keywords)
;; Populate OPTIONS and KEYWORDS.
- (dolist (entry (if (eq backend 'default) org-export-options-alist
- (org-export-backend-options backend)))
+ (dolist (entry (cond ((eq backend 'default) org-export-options-alist)
+ ((org-export-backend-p backend)
+ (org-export-get-all-options backend))
+ (t (org-export-get-all-options
+ (org-export-backend-name backend)))))
(let ((keyword (nth 1 entry))
(option (nth 2 entry)))
(cond
@@ -3502,16 +3559,20 @@ Caption lines are separated by a white space."
;; back-end, it may be used as a fall-back function once all specific
;; cases have been treated.
-(defun org-export-with-backend (back-end data &optional contents info)
- "Call a transcoder from BACK-END on DATA.
-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.."
- (org-export-barf-if-invalid-backend back-end)
+(defun org-export-with-backend (backend data &optional contents info)
+ "Call a transcoder from BACKEND on DATA.
+BACKEND is an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. DATA is an Org element, object, secondary
+string or string. CONTENTS, when non-nil, is the transcoded
+contents of DATA element, as a string. INFO, when non-nil, is
+the communication channel used for export, as a plist."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-barf-if-invalid-backend backend)
(let ((type (org-element-type data)))
(if (memq type '(nil org-data)) (error "No foreign transcoder available")
(let ((transcoder
- (cdr (assq type (org-export-backend-translate-table back-end)))))
+ (cdr (assq type (org-export-get-all-transcoders backend)))))
(if (functionp transcoder) (funcall transcoder data contents info)
(error "No foreign transcoder available"))))))
@@ -5849,43 +5910,31 @@ back to standard interface."
(lambda (value)
;; Fontify VALUE string.
(org-propertize value 'face 'font-lock-variable-name-face)))
- ;; Prepare menu entries by extracting them from
- ;; `org-export-registered-backends', and sorting them by
- ;; access key and by ordinal, if any.
- (backends
- (sort
- (sort
- (delq nil
- (mapcar
- (lambda (b)
- (let ((name (car b)))
- (catch 'ignored
- ;; Ignore any back-end belonging to
- ;; `org-export-invisible-backends' or derived
- ;; from one of them.
- (dolist (ignored org-export-invisible-backends)
- (when (org-export-derived-backend-p name ignored)
- (throw 'ignored nil)))
- (org-export-backend-menu name))))
- 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)))))
- (lambda (a b) (< (car a) (car b)))))
+ ;; 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 backends))
+ (if (not first-key) (org-uniquify (mapcar 'car entries))
(let (sub-menu)
- (dolist (backend backends (sort (mapcar 'car sub-menu) '<))
- (when (eq (car backend) first-key)
- (setq sub-menu (append (nth 2 backend) 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 ?& ?#)
@@ -5944,7 +5993,7 @@ back to standard interface."
(nth 1 sub-entry)))
sub-menu "")
(when (zerop (mod index 2)) "\n"))))))))
- backends ""))
+ entries ""))
;; Publishing menu is hard-coded.
(format "\n[%s] Publish
[%s] Current file [%s] Current project
@@ -5979,7 +6028,7 @@ back to standard interface."
;; UI, display an intrusive help buffer.
(if expertp
(org-export--dispatch-action
- expert-prompt allowed-keys backends options first-key expertp)
+ 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)
@@ -6002,15 +6051,15 @@ back to standard interface."
(set-window-start nil pos)))
(org-fit-window-to-buffer)
(org-export--dispatch-action
- standard-prompt allowed-keys backends options first-key expertp))))
+ standard-prompt allowed-keys entries options first-key expertp))))
(defun org-export--dispatch-action
- (prompt allowed-keys backends options first-key expertp)
+ (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.
-BACKENDS is a list of menu entries. OPTIONS, FIRST-KEY and
+ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and
EXPERTP are the same as defined in `org-export--dispatch-ui',
which see.
@@ -6067,9 +6116,9 @@ options as CDR."
first-key expertp))
;; Action selected: Send key and options back to
;; `org-export-dispatch'.
- ((or first-key (functionp (nth 2 (assq key backends))))
+ ((or first-key (functionp (nth 2 (assq key entries))))
(cons (cond
- ((not first-key) (nth 2 (assq key backends)))
+ ((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)
@@ -6082,10 +6131,10 @@ options as CDR."
;; path. Indeed, derived backends can share the same
;; FIRST-KEY.
(t (catch 'found
- (mapc (lambda (backend)
- (let ((match (assq key (nth 2 backend))))
+ (mapc (lambda (entry)
+ (let ((match (assq key (nth 2 entry))))
(when match (throw 'found (nth 2 match)))))
- (member (assq first-key backends) backends)))))
+ (member (assq first-key entries) entries)))))
options))
;; Otherwise, enter sub-menu.
(t (org-export--dispatch-ui options key expertp)))))
diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el
index cbae08a..0ba20f2 100644
--- a/testing/lisp/test-ox.el
+++ b/testing/lisp/test-ox.el
@@ -24,30 +24,22 @@
(unless (featurep 'ox)
(signal 'missing-test-dependency "org-export"))
-(defmacro org-test-with-backend (backend &rest body)
- "Execute body with an export back-end defined.
-
-BACKEND is the name of the back-end. BODY is the body to
-execute. The defined back-end simply returns parsed data as Org
-syntax."
- (declare (debug (form body)) (indent 1))
- `(let ((org-export-registered-backends
- ',(list
- (list backend
- :translate-alist
- (let (transcode-table)
- (dolist (type (append org-element-all-elements
- org-element-all-objects)
- transcode-table)
- (push
- (cons type
- (lambda (obj contents info)
- (funcall
- (intern (format "org-element-%s-interpreter"
- type))
- obj contents)))
- transcode-table)))))))
- (progn ,@body)))
+(defun org-test-default-backend ()
+ "Return a default export back-end.
+This back-end simply returns parsed data as Org syntax."
+ (org-export-create-backend
+ :transcoders (let (transcode-table)
+ (dolist (type (append org-element-all-elements
+ org-element-all-objects)
+ transcode-table)
+ (push
+ (cons type
+ (lambda (obj contents info)
+ (funcall
+ (intern (format "org-element-%s-interpreter"
+ type))
+ obj contents)))
+ transcode-table)))))
(defmacro org-test-with-parsed-data (data &rest body)
"Execute body with parsed data available.
@@ -108,12 +100,12 @@ already filled in `info'."
(should
(equal "Yes\n"
(org-test-with-temp-text "#+BIND: test-ox-var value"
- (let ((org-export-allow-bind-keywords t)
- org-export-registered-backends)
- (org-export-define-backend 'check
+ (let ((org-export-allow-bind-keywords t))
+ (org-export-as
+ (org-export-create-backend
+ :transcoders
'((section . (lambda (s c i)
- (if (eq test-ox-var 'value) "Yes" "No")))))
- (org-export-as 'check))))))
+ (if (eq test-ox-var 'value) "Yes" "No")))))))))))
(ert-deftest test-org-export/parse-option-keyword ()
"Test reading all standard #+OPTIONS: items."
@@ -276,14 +268,14 @@ Paragraph"
'equal
(org-test-with-temp-text-in-file "Test"
(org-mode)
- (let (org-export-registered-backends)
- (org-export-define-backend 'test
- '((template . (lambda (text info)
- (org-element-interpret-data
- (plist-get info :title) info)))))
- (list (org-export-as 'test)
- (file-name-nondirectory
- (file-name-sans-extension (buffer-file-name))))))))
+ (list (org-export-as
+ (org-export-create-backend
+ :transcoders
+ '((template . (lambda (text info)
+ (org-element-interpret-data
+ (plist-get info :title) info))))))
+ (file-name-nondirectory
+ (file-name-sans-extension (buffer-file-name)))))))
;; If no title is specified, and no file is associated to the
;; buffer, use buffer's name.
(should
@@ -291,36 +283,37 @@ Paragraph"
'equal
(org-test-with-temp-text "Test"
(org-mode)
- (let (org-export-registered-backends)
- (org-export-define-backend 'test
- '((template . (lambda (text info)
- (org-element-interpret-data
- (plist-get info :title) info)))))
- (list (org-export-as 'test) (buffer-name))))))
+ (list (org-export-as
+ (org-export-create-backend
+ :transcoders
+ '((template . (lambda (text info)
+ (org-element-interpret-data
+ (plist-get info :title) info))))))
+ (buffer-name)))))
;; If a title is specified, use it.
(should
(equal
"Title"
(org-test-with-temp-text-in-file "#+TITLE: Title\nTest"
(org-mode)
- (let (org-export-registered-backends)
- (org-export-define-backend 'test
- '((template . (lambda (text info)
- (org-element-interpret-data
- (plist-get info :title) info)))))
- (org-export-as 'test)))))
+ (org-export-as
+ (org-export-create-backend
+ :transcoders
+ '((template . (lambda (text info)
+ (org-element-interpret-data
+ (plist-get info :title) info)))))))))
;; If an empty title is specified, do not set it.
(should
(equal
""
(org-test-with-temp-text-in-file "#+TITLE:\nTest"
(org-mode)
- (let (org-export-registered-backends)
- (org-export-define-backend 'test
- '((template . (lambda (text info)
- (org-element-interpret-data
- (plist-get info :title) info)))))
- (org-export-as 'test))))))
+ (org-export-as
+ (org-export-create-backend
+ :transcoders
+ '((template . (lambda (text info)
+ (org-element-interpret-data
+ (plist-get info :title) info))))))))))
(ert-deftest test-org-export/handle-options ()
"Test if export options have an impact on output."
@@ -328,142 +321,148 @@ Paragraph"
(should
(equal ""
(org-test-with-temp-text "* Head1 :noexp:"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:exclude-tags ("noexp")))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:exclude-tags ("noexp"))))))
;; Test include tags for headlines and inlinetasks.
(should
(equal "* H2\n** Sub :exp:\n*** Sub Sub\n"
(org-test-with-temp-text "* H1\n* H2\n** Sub :exp:\n*** Sub Sub\n* H3"
(let ((org-tags-column 0))
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:select-tags ("exp"))))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:select-tags ("exp")))))))
;; Test mixing include tags and exclude tags.
- (org-test-with-temp-text "
+ (should
+ (string-match
+ "\\* Head1[ \t]+:export:\n\\*\\* Sub-Head2\n"
+ (org-test-with-temp-text "
* Head1 :export:
** Sub-Head1 :noexport:
** Sub-Head2
* Head2 :noexport:
** Sub-Head1 :export:"
- (org-test-with-backend test
- (should
- (string-match
- "\\* Head1[ \t]+:export:\n\\*\\* Sub-Head2\n"
- (org-export-as
- 'test nil nil nil
- '(:select-tags ("export") :exclude-tags ("noexport")))))))
+ (org-export-as (org-test-default-backend) nil nil nil
+ '(:select-tags ("export") :exclude-tags ("noexport"))))))
;; Ignore tasks.
(should
(equal ""
(let ((org-todo-keywords '((sequence "TODO" "DONE"))))
(org-test-with-temp-text "* TODO Head1"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:with-tasks nil)))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-tasks nil))))))
(should
(equal "* TODO Head1\n"
(let ((org-todo-keywords '((sequence "TODO" "DONE"))))
(org-test-with-temp-text "* TODO Head1"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:with-tasks t)))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-tasks t))))))
;; Archived tree.
- (org-test-with-temp-text "* Head1 :archive:"
- (let ((org-archive-tag "archive"))
- (org-test-with-backend test
- (should
- (equal (org-export-as 'test nil nil nil '(:with-archived-trees nil))
- "")))))
- (org-test-with-temp-text "* Head1 :archive:\nbody\n** Sub-head 2"
- (let ((org-archive-tag "archive"))
- (org-test-with-backend test
- (should
- (string-match
- "\\* Head1[ \t]+:archive:"
- (org-export-as 'test nil nil nil
- '(:with-archived-trees headline)))))))
- (org-test-with-temp-text "* Head1 :archive:"
- (let ((org-archive-tag "archive"))
- (org-test-with-backend test
- (should
- (string-match
- "\\`\\* Head1[ \t]+:archive:\n\\'"
- (org-export-as 'test nil nil nil '(:with-archived-trees t)))))))
+ (should
+ (equal ""
+ (org-test-with-temp-text "* Head1 :archive:"
+ (let ((org-archive-tag "archive"))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-archived-trees nil))))))
+ (should
+ (string-match
+ "\\* Head1[ \t]+:archive:"
+ (org-test-with-temp-text "* Head1 :archive:\nbody\n** Sub-head 2"
+ (let ((org-archive-tag "archive"))
+ (org-export-as (org-test-default-backend) nil nil nil
+ '(:with-archived-trees headline))))))
+ (should
+ (string-match
+ "\\`\\* Head1[ \t]+:archive:\n\\'"
+ (org-test-with-temp-text "* Head1 :archive:"
+ (let ((org-archive-tag "archive"))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-archived-trees t))))))
;; Clocks.
- (let ((org-clock-string "CLOCK:"))
- (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]"
- (org-test-with-backend test
- (should
- (equal (org-export-as 'test nil nil nil '(:with-clocks t))
- "CLOCK: [2012-04-29 sun. 10:45]\n"))
- (should
- (equal (org-export-as 'test nil nil nil '(:with-clocks nil)) "")))))
+ (should
+ (equal "CLOCK: [2012-04-29 sun. 10:45]\n"
+ (let ((org-clock-string "CLOCK:"))
+ (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]"
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-clocks t))))))
+ (should
+ (equal ""
+ (let ((org-clock-string "CLOCK:"))
+ (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]"
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-clocks nil))))))
;; Drawers.
- (let ((org-drawers '("TEST")))
- (org-test-with-temp-text ":TEST:\ncontents\n:END:"
- (org-test-with-backend test
- (should (equal (org-export-as 'test nil nil nil '(:with-drawers nil))
- ""))
- (should (equal (org-export-as 'test nil nil nil '(:with-drawers t))
- ":TEST:\ncontents\n:END:\n")))))
- (let ((org-drawers '("FOO" "BAR")))
- (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:"
- (org-test-with-backend test
- (should
- (equal (org-export-as 'test nil nil nil '(:with-drawers ("FOO")))
- ":FOO:\nkeep\n:END:\n")))))
- (let ((org-drawers '("FOO" "BAR")))
- (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:"
- (org-test-with-backend test
- (should
- (equal (org-export-as 'test nil nil nil '(:with-drawers (not "BAR")))
- ":FOO:\nkeep\n:END:\n")))))
+ (should
+ (equal ""
+ (let ((org-drawers '("TEST")))
+ (org-test-with-temp-text ":TEST:\ncontents\n:END:"
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-drawers nil))))))
+ (should
+ (equal ":TEST:\ncontents\n:END:\n"
+ (let ((org-drawers '("TEST")))
+ (org-test-with-temp-text ":TEST:\ncontents\n:END:"
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-drawers t))))))
+ (should
+ (equal ":FOO:\nkeep\n:END:\n"
+ (let ((org-drawers '("FOO" "BAR")))
+ (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:"
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-drawers ("FOO")))))))
+ (should
+ (equal ":FOO:\nkeep\n:END:\n"
+ (let ((org-drawers '("FOO" "BAR")))
+ (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:"
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-drawers (not "BAR")))))))
;; Footnotes.
(should
(equal "Footnote?"
(let ((org-footnote-section nil))
(org-test-with-temp-text "Footnote?[fn:1]\n\n[fn:1] Def"
- (org-test-with-backend test
- (org-trim
- (org-export-as 'test nil nil nil '(:with-footnotes nil))))))))
+ (org-trim (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-footnotes nil)))))))
(should
(equal "Footnote?[fn:1]\n\n[fn:1] Def"
(let ((org-footnote-section nil))
(org-test-with-temp-text "Footnote?[fn:1]\n\n[fn:1] Def"
- (org-test-with-backend test
- (org-trim
- (org-export-as 'test nil nil nil '(:with-footnotes t))))))))
+ (org-trim (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-footnotes t)))))))
;; Inlinetasks.
(when (featurep 'org-inlinetask)
(should
(equal
+ ""
(let ((org-inlinetask-min-level 15))
(org-test-with-temp-text "*************** Task"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:with-inlinetasks nil)))))
- ""))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-inlinetasks nil))))))
(should
(equal
+ ""
(let ((org-inlinetask-min-level 15))
(org-test-with-temp-text
"*************** Task\nContents\n*************** END"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:with-inlinetasks nil)))))
- "")))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-inlinetasks nil)))))))
;; Plannings.
- (let ((org-closed-string "CLOSED:"))
- (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]"
- (org-test-with-backend test
- (should
- (equal (org-export-as 'test nil nil nil '(:with-planning t))
- "CLOSED: [2012-04-29 sun. 10:45]\n"))
- (should
- (equal (org-export-as 'test nil nil nil '(:with-planning nil))
- "")))))
+ (should
+ (equal "CLOSED: [2012-04-29 sun. 10:45]\n"
+ (let ((org-closed-string "CLOSED:"))
+ (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]"
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-planning t))))))
+ (should
+ (equal ""
+ (let ((org-closed-string "CLOSED:"))
+ (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]"
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-planning nil))))))
;; Statistics cookies.
(should
(equal ""
(org-test-with-temp-text "[0/0]"
- (org-test-with-backend test
- (org-export-as
- 'test nil nil nil '(:with-statistics-cookies nil)))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-statistics-cookies nil))))))
(ert-deftest test-org-export/with-timestamps ()
"Test `org-export-with-timestamps' specifications."
@@ -472,15 +471,15 @@ Paragraph"
(equal
"[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>\n"
(org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:with-timestamps t))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-timestamps t)))))
;; nil value.
(should
(equal
""
(org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:with-timestamps nil))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-timestamps nil)))))
;; `active' value.
(should
(equal
@@ -489,9 +488,8 @@ Paragraph"
"<2012-03-29 Thu>[2012-03-29 Thu]
Paragraph <2012-03-29 Thu>[2012-03-29 Thu]"
- (org-test-with-backend test
- (org-trim
- (org-export-as 'test nil nil nil '(:with-timestamps active)))))))
+ (org-trim (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-timestamps active))))))
;; `inactive' value.
(should
(equal
@@ -500,16 +498,16 @@ Paragraph <2012-03-29 Thu>[2012-03-29 Thu]"
"<2012-03-29 Thu>[2012-03-29 Thu]
Paragraph <2012-03-29 Thu>[2012-03-29 Thu]"
- (org-test-with-backend test
- (org-trim
- (org-export-as 'test nil nil nil '(:with-timestamps inactive))))))))
+ (org-trim (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-timestamps inactive)))))))
(ert-deftest test-org-export/comment-tree ()
"Test if export process ignores commented trees."
- (let ((org-comment-string "COMMENT"))
- (org-test-with-temp-text "* COMMENT Head1"
- (org-test-with-backend test
- (should (equal (org-export-as 'test) ""))))))
+ (should
+ (equal ""
+ (let ((org-comment-string "COMMENT"))
+ (org-test-with-temp-text "* COMMENT Head1"
+ (org-export-as (org-test-default-backend)))))))
(ert-deftest test-org-export/export-scope ()
"Test all export scopes."
@@ -518,22 +516,23 @@ Paragraph <2012-03-29 Thu>[2012-03-29 Thu]"
** Head2
text
*** Head3"
- (org-test-with-backend test
- ;; Subtree.
- (forward-line 3)
- (should (equal (org-export-as 'test 'subtree) "text\n*** Head3\n"))
- ;; Visible.
- (goto-char (point-min))
- (forward-line)
- (org-cycle)
- (should (equal (org-export-as 'test nil 'visible) "* Head1\n"))
- ;; Region.
- (goto-char (point-min))
- (forward-line 3)
- (transient-mark-mode 1)
- (push-mark (point) t t)
- (goto-char (point-at-eol))
- (should (equal (org-export-as 'test) "text\n"))))
+ ;; Subtree.
+ (forward-line 3)
+ (should (equal (org-export-as (org-test-default-backend) 'subtree)
+ "text\n*** Head3\n"))
+ ;; Visible.
+ (goto-char (point-min))
+ (forward-line)
+ (org-cycle)
+ (should (equal (org-export-as (org-test-default-backend) nil 'visible)
+ "* Head1\n"))
+ ;; Region.
+ (goto-char (point-min))
+ (forward-line 3)
+ (transient-mark-mode 1)
+ (push-mark (point) t t)
+ (goto-char (point-at-eol))
+ (should (equal (org-export-as (org-test-default-backend)) "text\n")))
;; Subtree with a code block calling another block outside.
(should
(equal ": 3\n"
@@ -547,19 +546,18 @@ text
#+BEGIN_SRC emacs-lisp
\(+ 1 2)
#+END_SRC"
- (org-test-with-backend test
- (forward-line 1)
- (org-export-as 'test 'subtree)))))
+ (forward-line 1)
+ (org-export-as (org-test-default-backend) 'subtree))))
;; Body only.
- (org-test-with-temp-text "Text"
- (org-test-with-backend test
- (plist-put
- (cdr (assq 'test org-export-registered-backends))
- :translate-alist
- (cons (cons 'template (lambda (body info) (format "BEGIN\n%sEND" body)))
- (org-export-backend-translate-table 'test)))
- (should (equal (org-export-as 'test nil nil 'body-only) "Text\n"))
- (should (equal (org-export-as 'test) "BEGIN\nText\nEND")))))
+ (let ((backend (org-test-default-backend)))
+ (setf (org-export-backend-transcoders backend)
+ (cons '(template . (lambda (body i)
+ (format "BEGIN\n%sEND" body)))
+ (org-export-backend-transcoders backend)))
+ (org-test-with-temp-text "Text"
+ (should (equal (org-export-as backend nil nil 'body-only)
+ "Text\n"))
+ (should (equal (org-export-as backend) "BEGIN\nText\nEND")))))
(ert-deftest test-org-export/output-file-name ()
"Test `org-export-output-file-name' specifications."
@@ -667,7 +665,7 @@ body\n")))
(should
(equal "#+MACRO: macro1 value\nvalue\n"
(org-test-with-temp-text "#+MACRO: macro1 value\n{{{macro1}}}"
- (org-test-with-backend test (org-export-as 'test)))))
+ (org-export-as (org-test-default-backend)))))
;; Expand specific macros.
(should
(equal "me 2012-03-29 address@hidden Title\n"
@@ -678,7 +676,7 @@ body\n")))
#+AUTHOR: me
#+EMAIL: address@hidden
{{{author}}} {{{date}}} {{{email}}} {{{title}}}"
- (let ((output (org-test-with-backend test (org-export-as 'test))))
+ (let ((output (org-export-as (org-test-default-backend))))
(substring output (string-match ".*\n\\'" output))))))
;; Expand specific macros when property contained a regular macro
;; already.
@@ -688,7 +686,7 @@ body\n")))
#+MACRO: macro1 value
#+TITLE: {{{macro1}}}
{{{title}}}"
- (let ((output (org-test-with-backend test (org-export-as 'test))))
+ (let ((output (org-export-as (org-test-default-backend))))
(substring output (string-match ".*\n\\'" output))))))
;; Expand macros with templates in included files.
(should
@@ -696,57 +694,65 @@ body\n")))
(org-test-with-temp-text
(format "#+INCLUDE: \"%s/examples/macro-templates.org\"
{{{included-macro}}}" org-test-dir)
- (let ((output (org-test-with-backend test (org-export-as 'test))))
+ (let ((output (org-export-as (org-test-default-backend))))
(substring output (string-match ".*\n\\'" output)))))))
(ert-deftest test-org-export/user-ignore-list ()
"Test if `:ignore-list' accepts user input."
- (org-test-with-backend test
- (flet ((skip-note-head
- (data backend info)
- ;; Ignore headlines with the word "note" in their title.
- (org-element-map data 'headline
- (lambda (headline)
- (when (string-match "\\<note\\>"
- (org-element-property :raw-value headline))
- (org-export-ignore-element headline info)))
- info)
- data))
- ;; Install function in parse tree filters.
- (let ((org-export-filter-parse-tree-functions '(skip-note-head)))
- (org-test-with-temp-text "* Head1\n* Head2 (note)\n"
- (should (equal (org-export-as 'test) "* Head1\n")))))))
+ (let ((backend (org-test-default-backend)))
+ (setf (org-export-backend-transcoders backend)
+ (cons '(template . (lambda (body i)
+ (format "BEGIN\n%sEND" body)))
+ (org-export-backend-transcoders backend)))
+ (org-test-with-temp-text "Text"
+ (should (equal (org-export-as backend nil nil 'body-only)
+ "Text\n"))
+ (should (equal (org-export-as backend) "BEGIN\nText\nEND"))))
+ (should
+ (equal
+ "* Head1\n"
+ (let ((org-export-filter-parse-tree-functions
+ '((lambda (data backend info)
+ ;; Ignore headlines with the word "note" in their title.
+ (org-element-map data 'headline
+ (lambda (headline)
+ (when (string-match "\\<note\\>"
+ (org-element-property :raw-value
+ headline))
+ (org-export-ignore-element headline info)))
+ info)
+ data))))
+ (org-test-with-temp-text "* Head1\n* Head2 (note)\n"
+ (org-export-as (org-test-default-backend)))))))
(ert-deftest test-org-export/before-processing-hook ()
"Test `org-export-before-processing-hook'."
(should
(equal
"#+MACRO: mac val\nTest\n"
- (org-test-with-backend test
- (org-test-with-temp-text "#+MACRO: mac val\n{{{mac}}} Test"
- (let ((org-export-before-processing-hook
- '((lambda (backend)
- (while (re-search-forward "{{{" nil t)
- (let ((object (org-element-context)))
- (when (eq (org-element-type object) 'macro)
- (delete-region
- (org-element-property :begin object)
- (org-element-property :end object)))))))))
- (org-export-as 'test)))))))
+ (org-test-with-temp-text "#+MACRO: mac val\n{{{mac}}} Test"
+ (let ((org-export-before-processing-hook
+ '((lambda (backend)
+ (while (re-search-forward "{{{" nil t)
+ (let ((object (org-element-context)))
+ (when (eq (org-element-type object) 'macro)
+ (delete-region
+ (org-element-property :begin object)
+ (org-element-property :end object)))))))))
+ (org-export-as (org-test-default-backend)))))))
(ert-deftest test-org-export/before-parsing-hook ()
"Test `org-export-before-parsing-hook'."
(should
(equal "Body 1\nBody 2\n"
- (org-test-with-backend test
- (org-test-with-temp-text "* Headline 1\nBody 1\n* Headline 2\nBody
2"
- (let ((org-export-before-parsing-hook
- '((lambda (backend)
- (goto-char (point-min))
- (while (re-search-forward org-outline-regexp-bol nil t)
- (delete-region
- (point-at-bol) (progn (forward-line) (point))))))))
- (org-export-as 'test)))))))
+ (org-test-with-temp-text "* Headline 1\nBody 1\n* Headline 2\nBody 2"
+ (let ((org-export-before-parsing-hook
+ '((lambda (backend)
+ (goto-char (point-min))
+ (while (re-search-forward org-outline-regexp-bol nil t)
+ (delete-region
+ (point-at-bol) (progn (forward-line) (point))))))))
+ (org-export-as (org-test-default-backend)))))))
@@ -833,37 +839,37 @@ body\n")))
;; Translate table.
(should
(equal '((headline . my-headline-test))
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test '((headline . my-headline-test)))
- (org-export-backend-translate-table 'test))))
+ (org-export-get-all-transcoders 'test))))
;; Filters.
(should
(equal '((:filter-headline . my-filter))
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test
'((headline . my-headline-test))
:filters-alist '((:filter-headline . my-filter)))
- (org-export-backend-filters 'test))))
+ (org-export-backend-filters (org-export-get-backend 'test)))))
;; Options.
(should
(equal '((:prop value))
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test
'((headline . my-headline-test))
:options-alist '((:prop value)))
- (org-export-backend-options 'test))))
+ (org-export-backend-options (org-export-get-backend 'test)))))
;; Menu.
(should
(equal '(?k "Test Export" test)
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test
'((headline . my-headline-test))
:menu-entry '(?k "Test Export" test))
- (org-export-backend-menu 'test))))
+ (org-export-backend-menu (org-export-get-backend 'test)))))
;; Export Blocks.
(should
(equal '(("TEST" . org-element-export-block-parser))
- (let (org-export-registered-backends org-element-block-name-alist)
+ (let (org-export--registered-backends org-element-block-name-alist)
(org-export-define-backend 'test
'((headline . my-headline-test))
:export-block '("test"))
@@ -873,115 +879,218 @@ body\n")))
"Test `org-export-define-derived-backend' specifications."
;; Error when parent back-end is not defined.
(should-error
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-derived-backend 'test 'parent)))
;; Append translation table to parent's.
(should
(equal '((:headline . test) (:headline . parent))
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'parent '((:headline . parent)))
(org-export-define-derived-backend 'test 'parent
:translate-alist '((:headline . test)))
- (org-export-backend-translate-table 'test))))
+ (org-export-get-all-transcoders 'test))))
;; Options defined in the new back have priority over those defined
;; in parent.
(should
(eq 'test
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'parent
'((:headline . parent))
:options-alist '((:a nil nil 'parent)))
(org-export-define-derived-backend 'test 'parent
:options-alist '((:a nil nil 'test)))
- (plist-get (org-export--get-global-options 'test) :a)))))
+ (plist-get (org-export--get-global-options
+ (org-export-get-backend 'test))
+ :a)))))
(ert-deftest test-org-export/derived-backend-p ()
"Test `org-export-derived-backend-p' specifications."
;; Non-nil with direct match.
(should
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test '((headline . test)))
(org-export-derived-backend-p 'test 'test)))
(should
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test '((headline . test)))
(org-export-define-derived-backend 'test2 'test)
(org-export-derived-backend-p 'test2 'test2)))
;; Non-nil with a direct parent.
(should
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test '((headline . test)))
(org-export-define-derived-backend 'test2 'test)
(org-export-derived-backend-p 'test2 'test)))
;; Non-nil with an indirect parent.
(should
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test '((headline . test)))
(org-export-define-derived-backend 'test2 'test)
(org-export-define-derived-backend 'test3 'test2)
(org-export-derived-backend-p 'test3 'test)))
;; Nil otherwise.
(should-not
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test '((headline . test)))
(org-export-define-backend 'test2 '((headline . test2)))
(org-export-derived-backend-p 'test2 'test)))
(should-not
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test '((headline . test)))
(org-export-define-backend 'test2 '((headline . test2)))
(org-export-define-derived-backend 'test3 'test2)
(org-export-derived-backend-p 'test3 'test))))
+(ert-deftest test-org-export/get-all-transcoders ()
+ "Test `org-export-get-all-transcoders' specifications."
+ ;; Return nil when back-end cannot be found.
+ (should-not (org-export-get-all-transcoders nil))
+ ;; Same as `org-export-transcoders' if no parent.
+ (should
+ (equal '((headline . ignore))
+ (org-export-get-all-transcoders
+ (org-export-create-backend
+ :transcoders '((headline . ignore))))))
+ ;; But inherit from all ancestors whenever possible.
+ (should
+ (equal '((section . ignore) (headline . ignore))
+ (let (org-export--registered-backends)
+ (org-export-define-backend 'b1 '((headline . ignore)))
+ (org-export-get-all-transcoders
+ (org-export-create-backend
+ :parent 'b1 :transcoders '((section . ignore)))))))
+ (should
+ (equal '((paragraph . ignore) (section . ignore) (headline . ignore))
+ (let (org-export--registered-backends)
+ (org-export-define-backend 'b1 '((headline . ignore)))
+ (org-export-define-derived-backend 'b2 'b1
+ :translate-alist '((section . ignore)))
+ (org-export-get-all-transcoders
+ (org-export-create-backend
+ :parent 'b2 :transcoders '((paragraph . ignore)))))))
+ ;; Back-end transcoders overrule inherited ones.
+ (should
+ (eq 'b
+ (let (org-export--registered-backends)
+ (org-export-define-backend 'b1 '((headline . a)))
+ (cdr (assq 'headline
+ (org-export-get-all-transcoders
+ (org-export-create-backend
+ :parent 'b1 :transcoders '((headline . b))))))))))
+
+(ert-deftest test-org-export/get-all-options ()
+ "Test `org-export-get-all-options' specifications."
+ ;; Return nil when back-end cannot be found.
+ (should-not (org-export-get-all-options nil))
+ ;; Same as `org-export-options' if no parent.
+ (should
+ (equal '((headline . ignore))
+ (org-export-get-all-options
+ (org-export-create-backend
+ :options '((headline . ignore))))))
+ ;; But inherit from all ancestors whenever possible.
+ (should
+ (equal '((:key2 value2) (:key1 value1))
+ (let (org-export--registered-backends)
+ (org-export-define-backend 'b1 nil :options-alist '((:key1 value1)))
+ (org-export-get-all-options
+ (org-export-create-backend
+ :parent 'b1 :options '((:key2 value2)))))))
+ (should
+ (equal '((:key3 value3) (:key2 value2) (:key1 value1))
+ (let (org-export--registered-backends)
+ (org-export-define-backend 'b1 nil :options-alist '((:key1 value1)))
+ (org-export-define-derived-backend 'b2 'b1
+ :options-alist '((:key2 value2)))
+ (org-export-get-all-options
+ (org-export-create-backend
+ :parent 'b2 :options '((:key3 value3)))))))
+ ;; Back-end options overrule inherited ones.
+ (should
+ (eq 'b
+ (let (org-export--registered-backends)
+ (org-export-define-backend 'b1 nil :options-alist '((:key1 . a)))
+ (cdr (assq :key1
+ (org-export-get-all-options
+ (org-export-create-backend
+ :parent 'b1 :options '((:key1 . b))))))))))
+
+(ert-deftest test-org-export/get-all-filters ()
+ "Test `org-export-get-all-filters' specifications."
+ ;; Return nil when back-end cannot be found.
+ (should-not (org-export-get-all-filters nil))
+ ;; Same as `org-export-filters' if no parent.
+ (should
+ (equal '((:filter-headline . ignore))
+ (org-export-get-all-filters
+ (org-export-create-backend
+ :filters '((:filter-headline . ignore))))))
+ ;; But inherit from all ancestors whenever possible.
+ (should
+ (equal '((:filter-section . ignore) (:filter-headline . ignore))
+ (let (org-export--registered-backends)
+ (org-export-define-backend 'b1
+ nil :filters-alist '((:filter-headline . ignore)))
+ (org-export-get-all-filters
+ (org-export-create-backend
+ :parent 'b1 :filters '((:filter-section . ignore)))))))
+ (should
+ (equal '((:filter-paragraph . ignore)
+ (:filter-section . ignore)
+ (:filter-headline . ignore))
+ (let (org-export--registered-backends)
+ (org-export-define-backend 'b1
+ nil :filters-alist '((:filter-headline . ignore)))
+ (org-export-define-derived-backend 'b2 'b1
+ :filters-alist '((:filter-section . ignore)))
+ (org-export-get-all-filters
+ (org-export-create-backend
+ :parent 'b2 :filters '((:filter-paragraph . ignore)))))))
+ ;; Back-end filters overrule inherited ones.
+ (should
+ (eq 'b
+ (let (org-export--registered-backends)
+ (org-export-define-backend 'b1 '((:filter-headline . a)))
+ (cdr (assq :filter-headline
+ (org-export-get-all-filters
+ (org-export-create-backend
+ :parent 'b1 :filters '((:filter-headline . b))))))))))
+
(ert-deftest test-org-export/with-backend ()
"Test `org-export-with-backend' definition."
;; Error when calling an undefined back-end
- (should-error
- (let (org-export-registered-backends)
- (org-export-with-backend 'test "Test")))
+ (should-error (org-export-with-backend nil "Test"))
;; Error when called back-end doesn't have an appropriate
;; transcoder.
(should-error
- (let (org-export-registered-backends)
- (org-export-define-backend 'test ((headline . ignore)))
- (org-export-with-backend 'test "Test")))
+ (org-export-with-backend
+ (org-export-create-backend :transcoders '((headline . ignore)))
+ "Test"))
;; Otherwise, export using correct transcoder
(should
(equal "Success"
- (let (org-export-registered-backends)
+ (let (org-export--registered-backends)
(org-export-define-backend 'test
'((plain-text . (lambda (text contents info) "Failure"))))
(org-export-define-backend 'test2
'((plain-text . (lambda (text contents info) "Success"))))
(org-export-with-backend 'test2 "Test")))))
-(ert-deftest test-org-export/data-with-translations ()
- "Test `org-export-data-with-translations' specifications."
- (should
- (equal
- "Success!"
- (org-export-data-with-translations
- '(bold nil "Test")
- '((plain-text . (lambda (text info) "Success"))
- (bold . (lambda (bold contents info) (concat contents "!"))))
- '(:with-emphasize t)))))
-
(ert-deftest test-org-export/data-with-backend ()
"Test `org-export-data-with-backend' specifications."
;; Error when calling an undefined back-end.
- (should-error
- (let (org-export-registered-backends)
- (org-export-data-with-backend 'test "Test" nil)))
+ (should-error (org-export-data-with-backend nil "nil" nil))
;; Otherwise, export data recursively, using correct back-end.
(should
(equal
"Success!"
- (let (org-export-registered-backends)
- (org-export-define-backend 'test
- '((plain-text . (lambda (text info) "Success"))
- (bold . (lambda (bold contents info) (concat contents "!")))))
- (org-export-data-with-backend
- '(bold nil "Test") 'test '(:with-emphasize t))))))
+ (org-export-data-with-backend
+ '(bold nil "Test")
+ (org-export-create-backend
+ :transcoders
+ '((plain-text . (lambda (text info) "Success"))
+ (bold . (lambda (bold contents info) (concat contents "!")))))
+ '(:with-emphasize t)))))
@@ -989,28 +1098,30 @@ body\n")))
(ert-deftest test-org-export/export-snippet ()
"Test export snippets transcoding."
+ ;; Standard test.
(org-test-with-temp-text "@@test:A@@@@t:B@@"
- (org-test-with-backend test
- (plist-put
- (cdr (assq 'test org-export-registered-backends))
- :translate-alist
- (cons (cons 'export-snippet
- (lambda (snippet contents info)
- (when (eq (org-export-snippet-backend snippet) 'test)
- (org-element-property :value snippet))))
- (org-export-backend-translate-table 'test)))
+ (let ((backend (org-test-default-backend)))
+ (setf (org-export-backend-name backend) 'test)
+ (setf (org-export-backend-transcoders backend)
+ (cons (cons 'export-snippet
+ (lambda (snippet contents info)
+ (when (eq (org-export-snippet-backend snippet) 'test)
+ (org-element-property :value snippet))))
+ (org-export-backend-transcoders backend)))
(let ((org-export-snippet-translation-alist nil))
- (should (equal (org-export-as 'test) "A\n")))
+ (should (equal (org-export-as backend) "A\n")))
(let ((org-export-snippet-translation-alist '(("t" . "test"))))
- (should (equal (org-export-as 'test) "AB\n")))))
+ (should (equal (org-export-as backend) "AB\n")))))
;; Ignored export snippets do not remove any blank.
(should
(equal "begin end\n"
(org-test-with-parsed-data "begin @@test:A@@ end"
- (org-export-data-with-translations
+ (org-export-data-with-backend
tree
- '((paragraph . (lambda (paragraph contents info) contents))
- (section . (lambda (section contents info) contents)))
+ (org-export-create-backend
+ :transcoders
+ '((paragraph . (lambda (paragraph contents info) contents))
+ (section . (lambda (section contents info) contents))))
info)))))
@@ -1036,11 +1147,11 @@ body\n")))
(car (org-element-contents def))))))))
info))))
;; 2. Test nested footnotes order.
- (org-test-with-parsed-data
- "Text[fn:1:A[fn:2]] [fn:3].\n\n[fn:2] B [fn:3] [fn::D].\n\n[fn:3] C."
- (should
- (equal
- '((1 . "fn:1") (2 . "fn:2") (3 . "fn:3") (4))
+ (should
+ (equal
+ '((1 . "fn:1") (2 . "fn:2") (3 . "fn:3") (4))
+ (org-test-with-parsed-data
+ "Text[fn:1:A[fn:2]] [fn:3].\n\n[fn:2] B [fn:3] [fn::D].\n\n[fn:3] C."
(org-element-map tree 'footnote-reference
(lambda (ref)
(when (org-export-footnote-first-reference-p ref info)
@@ -1060,29 +1171,30 @@ body\n")))
(should
(= (length (org-export-collect-footnote-definitions tree info)) 2))))
;; 4. Test footnotes definitions collection.
- (org-test-with-parsed-data "Text[fn:1:A[fn:2]] [fn:3].
+ (should
+ (= 4
+ (org-test-with-parsed-data "Text[fn:1:A[fn:2]] [fn:3].
\[fn:2] B [fn:3] [fn::D].
\[fn:3] C."
- (should (= (length (org-export-collect-footnote-definitions tree info))
- 4)))
+ (length (org-export-collect-footnote-definitions tree info)))))
;; 5. Test export of footnotes defined outside parsing scope.
- (org-test-with-temp-text "[fn:1] Out of scope
+ (should
+ (equal
+ "ParagraphOut of scope\n"
+ (org-test-with-temp-text "[fn:1] Out of scope
* Title
Paragraph[fn:1]"
- (org-test-with-backend test
- (plist-put
- (cdr (assq 'test org-export-registered-backends))
- :translate-alist
- (cons (cons 'footnote-reference
- (lambda (fn contents info)
- (org-element-interpret-data
- (org-export-get-footnote-definition fn info))))
- (org-export-backend-translate-table 'test)))
- (forward-line)
- (should (equal "ParagraphOut of scope\n"
- (org-export-as 'test 'subtree)))))
+ (let ((backend (org-test-default-backend)))
+ (setf (org-export-backend-transcoders backend)
+ (cons (cons 'footnote-reference
+ (lambda (fn contents info)
+ (org-element-interpret-data
+ (org-export-get-footnote-definition fn info))))
+ (org-export-backend-transcoders backend)))
+ (forward-line)
+ (org-export-as backend 'subtree)))))
;; 6. Footnotes without a definition should be provided a fallback
;; definition.
(should
@@ -1378,8 +1490,8 @@ Paragraph[fn:1]"
""
(let ((org-inlinetask-min-level 3))
(org-test-with-temp-text "*** Inlinetask :noexp:\nContents\n*** end"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:exclude-tags ("noexp"))))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:exclude-tags ("noexp")))))))
;; Inlinetask with an include tag.
(should
(equal
@@ -1387,16 +1499,16 @@ Paragraph[fn:1]"
(let ((org-inlinetask-min-level 3)
(org-tags-column 0))
(org-test-with-temp-text "* H1\n* H2\n*** Inline :exp:"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:select-tags ("exp"))))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:select-tags ("exp")))))))
;; Ignore inlinetask with a TODO keyword and tasks excluded.
(should
(equal ""
(let ((org-todo-keywords '((sequence "TODO" "DONE")))
(org-inlinetask-min-level 3))
(org-test-with-temp-text "*** TODO Inline"
- (org-test-with-backend test
- (org-export-as 'test nil nil nil '(:with-tasks nil)))))))))
+ (org-export-as (org-test-default-backend)
+ nil nil nil '(:with-tasks nil))))))))
@@ -2492,41 +2604,40 @@ Another text. (ref:text)
"Test `inner-template' translator specifications."
(should
(equal "Success!"
- (let (org-export-registered-backends)
- (org-export-define-backend 'test
+ (org-test-with-temp-text "* Headline"
+ (org-export-as
+ (org-export-create-backend
+ :transcoders
'((inner-template . (lambda (contents info) "Success!"))
- (headline . (lambda (h c i) "Headline"))))
- (org-test-with-temp-text "* Headline"
- (org-export-as 'test)))))
+ (headline . (lambda (h c i) "Headline"))))))))
;; Inner template is applied even in a "body-only" export.
(should
(equal "Success!"
- (let (org-export-registered-backends)
- (org-export-define-backend 'test
- '((inner-template . (lambda (contents info) "Success!"))
- (headline . (lambda (h c i) "Headline"))))
- (org-test-with-temp-text "* Headline"
- (org-export-as 'test nil nil 'body-only))))))
+ (org-test-with-temp-text "* Headline"
+ (org-export-as
+ (org-export-create-backend
+ :transcoders '((inner-template . (lambda (c i) "Success!"))
+ (headline . (lambda (h c i) "Headline"))))
+ nil nil 'body-only)))))
(ert-deftest test-org-export/template ()
"Test `template' translator specifications."
(should
(equal "Success!"
- (let (org-export-registered-backends)
- (org-export-define-backend 'test
- '((template . (lambda (contents info) "Success!"))
- (headline . (lambda (h c i) "Headline"))))
- (org-test-with-temp-text "* Headline"
- (org-export-as 'test)))))
+ (org-test-with-temp-text "* Headline"
+ (org-export-as
+ (org-export-create-backend
+ :transcoders '((template . (lambda (contents info) "Success!"))
+ (headline . (lambda (h c i) "Headline"))))))))
;; Template is not applied in a "body-only" export.
(should-not
(equal "Success!"
- (let (org-export-registered-backends)
- (org-export-define-backend 'test
- '((template . (lambda (contents info) "Success!"))
- (headline . (lambda (h c i) "Headline"))))
- (org-test-with-temp-text "* Headline"
- (org-export-as 'test nil nil 'body-only))))))
+ (org-test-with-temp-text "* Headline"
+ (org-export-as
+ (org-export-create-backend
+ :transcoders '((template . (lambda (contents info) "Success!"))
+ (headline . (lambda (h c i) "Headline"))))
+ nil nil 'body-only)))))
--
1.8.3.2
>From 5c3b1765d219fc55edac393460128b9cd8d0d013 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <address@hidden>
Date: Mon, 24 Jun 2013 20:55:24 +0200
Subject: [PATCH 2/2] Export back-ends: Apply changes to back-end structure
* lisp/ox-html.el (org-html--format-toc-headline): Make use of
anonymous back-ends.
* lisp/ox-odt.el (org-odt-footnote-reference): Make use of anonymous
back-ends.
(org-odt-format-label, org-odt-toc, org-odt-format-headline--wrap):
Use `org-export-with-backend' instead of
`org-export-with-translations'.
* contrib/lisp/ox-freemind.el (org-freemind--build-node-contents): Use
`org-export-with-backend' instead of `org-export-with-translations'.
---
contrib/lisp/ox-freemind.el | 11 +++---
lisp/ox-html.el | 19 ++++++-----
lisp/ox-odt.el | 83 +++++++++++++++++++++++----------------------
3 files changed, 57 insertions(+), 56 deletions(-)
diff --git a/contrib/lisp/ox-freemind.el b/contrib/lisp/ox-freemind.el
index 4e90eff..d31c65f 100644
--- a/contrib/lisp/ox-freemind.el
+++ b/contrib/lisp/ox-freemind.el
@@ -316,12 +316,11 @@ will result in following node:
(element-contents (org-element-contents element))
(section (assoc 'section element-contents))
(section-contents
- (let* ((translations
- (nconc (list (cons 'section
- (lambda (section contents info)
- contents)))
- (plist-get info :translate-alist))))
- (org-export-data-with-translations section translations info)))
+ (let ((backend (org-export-create-backend
+ :parent (org-export-backend-name
+ (plist-get info :back-end))
+ :translations '(section . (lambda (e c i) c)))))
+ (org-export-data-with-backend section backend info)))
(itemized-contents-p (let ((first-child-headline
(org-element-map element-contents
'headline 'identity info t)))
diff --git a/lisp/ox-html.el b/lisp/ox-html.el
index 9ce73c4..0c997b4 100644
--- a/lisp/ox-html.el
+++ b/lisp/ox-html.el
@@ -1983,16 +1983,17 @@ INFO is a plist used as a communication channel."
headline-number "-"))))
;; Body.
(concat section-number
- (org-export-data-with-translations
+ (org-export-data-with-backend
(org-export-get-alt-title headline info)
- ;; Ignore any footnote-reference, link,
- ;; radio-target and target in table of contents.
- (append
- '((footnote-reference . ignore)
- (link . (lambda (link desc i) desc))
- (radio-target . (lambda (radio desc i) desc))
- (target . ignore))
- (org-export-backend-translate-table 'html))
+ ;; Create an anonymous back-end that will ignore
+ ;; any footnote-reference, link, radio-target and
+ ;; target in table of contents.
+ (org-export-create-backend
+ :parent 'html
+ :transcoders '((footnote-reference . ignore)
+ (link . (lambda (object c i) c))
+ (radio-target . (lambda (object c i) c))
+ (target . ignore)))
info)
(and tags "   ") (org-html--tags tags)))))
diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el
index 1cccdc6..abf88cd 100644
--- a/lisp/ox-odt.el
+++ b/lisp/ox-odt.el
@@ -1152,20 +1152,19 @@ See `org-odt--build-date-styles' for implementation
details."
(let* ((title (org-export-translate "Table of Contents" :utf-8 info))
(headlines (org-export-collect-headlines
info (and (wholenump depth) depth)))
- (translations (nconc (mapcar
- (lambda (type)
- (cons type (lambda (data contents info)
- contents)))
- (list 'radio-target))
- (plist-get info :translate-alist))))
+ (backend (org-export-create-backend
+ :parent (org-export-backend-name
+ (plist-get info :back-end))
+ :transcoders (mapcar
+ (lambda (type) (cons type (lambda (d c i) c)))
+ (list 'radio-target)))))
(when headlines
(concat
(org-odt-begin-toc title depth)
(mapconcat
(lambda (headline)
(let* ((entry (org-odt-format-headline--wrap
- headline translations info
- 'org-odt-format-toc-headline))
+ headline backend info 'org-odt-format-toc-headline))
(level (org-export-get-relative-level headline info))
(style (format "Contents_20_%d" level)))
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
@@ -1731,18 +1730,22 @@ CONTENTS is nil. INFO is a plist holding contextual
information."
(t
(let* ((raw (org-export-get-footnote-definition
footnote-reference info))
- (translations
- (cons (cons 'paragraph
- (lambda (p c i)
- (org-odt--format-paragraph
- p c "Footnote" "OrgFootnoteCenter"
- "OrgFootnoteQuotations")))
- (org-export-backend-translate-table 'odt)))
- (def (let ((def (org-trim (org-export-data-with-translations
- raw translations info))))
- (if (eq (org-element-type raw) 'org-data) def
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "Footnote" def)))))
+ (def
+ (let ((def (org-trim
+ (org-export-data-with-backend
+ raw
+ (org-export-create-backend
+ :parent 'odt
+ :transcoders
+ '((paragraph . (lambda (p c i)
+ (org-odt--format-paragraph
+ p c "Footnote"
+ "OrgFootnoteCenter"
+ "OrgFootnoteQuotations")))))
+ info))))
+ (if (eq (org-element-type raw) 'org-data) def
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Footnote" def)))))
(funcall --format-footnote-definition n def))))))))
@@ -1775,13 +1778,12 @@ CONTENTS is nil. INFO is a plist holding contextual
information."
"<text:span text:style-name=\"%s\">%s</text:span>"
"OrgTag" tag)) tags " : "))))))
-(defun org-odt-format-headline--wrap (headline translations info
- &optional format-function
- &rest extra-keys)
- "Transcode a HEADLINE element from Org to ODT.
-CONTENTS holds the contents of the headline. INFO is a plist
-holding contextual information."
- (setq translations (or translations (plist-get info :translate-alist)))
+(defun org-odt-format-headline--wrap (headline backend info
+ &optional format-function
+ &rest extra-keys)
+ "Transcode a HEADLINE element using BACKEND.
+INFO is a plist holding contextual information."
+ (setq backend (or backend (plist-get info :back-end)))
(let* ((level (+ (org-export-get-relative-level headline info)))
(headline-number (org-export-get-headline-number headline info))
(section-number (and (org-export-numbered-headline-p headline info)
@@ -1789,13 +1791,13 @@ holding contextual information."
headline-number ".")))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
- (and todo (org-export-data-with-translations
- todo translations info)))))
+ (and todo
+ (org-export-data-with-backend todo backend info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
- (text (org-export-data-with-translations
- (org-element-property :title headline) translations info))
+ (text (org-export-data-with-backend
+ (org-element-property :title headline) backend info))
(tags (and (plist-get info :with-tags)
(org-export-get-tags headline info)))
(headline-label (concat "sec-" (mapconcat 'number-to-string
@@ -1805,7 +1807,7 @@ holding contextual information."
((functionp org-odt-format-headline-function)
(function*
(lambda (todo todo-type priority text tags
- &allow-other-keys)
+ &allow-other-keys)
(funcall org-odt-format-headline-function
todo todo-type priority text tags))))
(t 'org-odt-format-headline))))
@@ -1934,7 +1936,7 @@ holding contextual information."
(let ((format-function
(function*
(lambda (todo todo-type priority text tags
- &key contents &allow-other-keys)
+ &key contents &allow-other-keys)
(funcall org-odt-format-inlinetask-function
todo todo-type priority text tags contents)))))
(org-odt-format-headline--wrap
@@ -2149,15 +2151,14 @@ SHORT-CAPTION are strings."
;; will do.
(short-caption
(let ((short-caption (or short-caption caption))
- (translations (nconc (mapcar
- (lambda (type)
- (cons type (lambda (data contents info)
- contents)))
- org-element-all-objects)
- (plist-get info :translate-alist))))
+ (backend (org-export-create-backend
+ :parent (org-export-backend-name
+ (plist-get info :back-end))
+ :transcoders
+ (mapcar (lambda (type) (cons type (lambda (o c i) c)))
+ org-element-all-objects))))
(when short-caption
- (org-export-data-with-translations short-caption
- translations info)))))
+ (org-export-data-with-backend short-caption backend info)))))
(when (or label caption)
(let* ((default-category
(case (org-element-type element)
--
1.8.3.2