From 35bf951a1cd4c455f01863e128a899d36e76a76c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou 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 me@here Title\n" @@ -678,7 +676,7 @@ body\n"))) #+AUTHOR: me #+EMAIL: me@here {{{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 "\\" - (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 "\\" + (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