mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2025-01-29 20:35:02 +00:00
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) ...))
This commit is contained in:
parent
60abb38ee3
commit
74faf5bd26
@ -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
|
||||
|
@ -571,6 +571,104 @@ body\n")))
|
||||
(org-export-get-caption (org-element-at-point))))))
|
||||
|
||||
|
||||
|
||||
;;; 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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user