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)
      ...))

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

testing/lisp/test-org-export.el

@@ -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