diff options
author | Nicolas Goaziou <n.goaziou@gmail.com> | 2012-11-17 13:33:38 +0100 |
---|---|---|
committer | Nicolas Goaziou <n.goaziou@gmail.com> | 2012-11-17 13:33:38 +0100 |
commit | 74faf5bd26d4aea1124dd087fbd99323559459ff (patch) | |
tree | d36fb934e2f2a8448f46c2931bea8545a7254063 | |
parent | 60abb38ee3825f4f440ed7cd0c05d40fd70961bf (diff) | |
download | org-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.el | 12 | ||||
-rw-r--r-- | testing/lisp/test-org-export.el | 98 |
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 () |