summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2012-11-17 13:33:38 +0100
committerNicolas Goaziou <n.goaziou@gmail.com>2012-11-17 13:33:38 +0100
commit74faf5bd26d4aea1124dd087fbd99323559459ff (patch)
treed36fb934e2f2a8448f46c2931bea8545a7254063
parent60abb38ee3825f4f440ed7cd0c05d40fd70961bf (diff)
downloadorg-mode-74faf5bd26d4aea1124dd087fbd99323559459ff.tar.gz
org-export: New `org-export-derived-backend-p' predicate
* contrib/lisp/org-export.el (org-export-define-derived-backend): Add `:parent' property to derived backend. (org-export-derived-backend-p): New function. * testing/lisp/test-org-export.el: Add tests. This function can be useful in filters implemation. I.e. (defun my-filter (contents backend info) (when (memq backend '(e-latex e-beamer some-derived-backend-from-latex)) ...)) can be replaced with: (defun my filter (contents backend info) (when (org-export-derived-backend-p backend 'e-latex) ...))
-rw-r--r--contrib/lisp/org-export.el12
-rw-r--r--testing/lisp/test-org-export.el98
2 files changed, 110 insertions, 0 deletions
diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
index 9f0827a..c9f0edc 100644
--- a/contrib/lisp/org-export.el
+++ b/contrib/lisp/org-export.el
@@ -925,6 +925,7 @@ The back-end could then be called with, for example:
\(org-export-to-buffer 'my-latex \"*Test my-latex*\")"
(declare (debug (&define name sexp [&rest [keywordp sexp]] def-body))
(indent 2))
+ (org-export-barf-if-invalid-backend parent)
(let (export-block filters menu-entry options translators contents)
(while (keywordp (car body))
(case (pop body)
@@ -938,6 +939,7 @@ The back-end could then be called with, for example:
(:translate-alist (setq translators (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)))
@@ -985,6 +987,16 @@ The back-end could then be called with, for example:
(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
+ (plist-get (cdr (assq parent
+ org-export-registered-backends))
+ :parent))))
+ parent))
+
;;; The Communication Channel
diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el
index ba70e20..7eb9f99 100644
--- a/testing/lisp/test-org-export.el
+++ b/testing/lisp/test-org-export.el
@@ -572,6 +572,104 @@ body\n")))
+;;; Back-end Definition
+
+(ert-deftest test-org-export/define-backend ()
+ "Test back-end definition and accessors."
+ ;; Translate table.
+ (should
+ (equal '((headline . my-headline-test))
+ (let (org-export-registered-backends)
+ (org-export-define-backend test ((headline . my-headline-test)))
+ (org-export-backend-translate-table 'test))))
+ ;; Filters.
+ (should
+ (equal '((:filter-headline . my-filter))
+ (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))))
+ ;; Options.
+ (should
+ (equal '((:prop value))
+ (let (org-export-registered-backends)
+ (org-export-define-backend test
+ ((headline . my-headline-test))
+ :options-alist ((:prop value)))
+ (org-export-backend-options 'test))))
+ ;; Menu.
+ (should
+ (equal '(?k "Test Export" test)
+ (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))))
+ ;; Export Blocks.
+ (should
+ (equal '(("TEST" . org-element-export-block-parser))
+ (let (org-export-registered-backends org-element-block-name-alist)
+ (org-export-define-backend test
+ ((headline . my-headline-test))
+ :export-block ("test"))
+ org-element-block-name-alist))))
+
+(ert-deftest test-org-export/define-derived-backend ()
+ "Test `org-export-define-derived-backend' specifications."
+ ;; Error when parent back-end is not defined.
+ (should-error
+ (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)
+ (org-export-define-backend parent ((:headline . parent)))
+ (org-export-define-derived-backend test parent
+ :translate-alist ((:headline . test)))
+ (org-export-backend-translate-table 'test)))))
+
+(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)
+ (org-export-define-backend test ((headline . test)))
+ (org-export-derived-backend-p 'test 'test)))
+ (should
+ (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)
+ (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)
+ (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)
+ (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)
+ (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))))
+
+
+
;;; Export Snippets
(ert-deftest test-org-export/export-snippet ()