From 2160b3d2422fb877fbcc6283ae561a9c59b5621a Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Date: Sat, 26 Jul 2014 17:18:10 +0200
Subject: [PATCH] ox: Implement predicate for export blocks

* lisp/ox.el (org-export-raw-special-block-p): New function.

* testing/lisp/test-ox.el (test-org-export/raw-special-block-p): New
  test.

This patch is a forward-compatibility measure since the function is
mandatory for export back-ends in Org 8.3. It makes it easier for
back-end maintainers to provide a back-end compatible with both Org
8.2 and 8.3.
---
 lisp/ox.el              | 25 ++++++++++++++++++--
 testing/lisp/test-ox.el | 62 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 85 insertions(+), 2 deletions(-)

diff --git a/lisp/ox.el b/lisp/ox.el
index 03bd8bb72..6d07a2e8a 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -4134,8 +4134,29 @@ objects of the same type."
 	    ((funcall predicate el info) (incf counter) nil)))
 	 info 'first-match)))))
 
-
-;;;; For Src-Blocks
+;;;; For Special Blocks
+;;
+;; `org-export-raw-special-block-p' check if current special block is
+;; an "export block", i.e., a block whose contents should be inserted
+;; as-is in the output.  This should generally be the first check to
+;; do when handling special blocks in the export back-end.
+
+(defun org-export-raw-special-block-p (element info &optional no-inheritance)
+  "Non-nil if ELEMENT is an export block relatively to current back-end.
+An export block is a special block whose contents should be
+included as-is in the final output.  Such blocks are defined
+through :export-block property in `org-export-define-backend',
+which see."
+  (and (eq (org-element-type element) 'special-block)
+       (let ((type (org-element-property :type element))
+	     (b (plist-get info :back-end)))
+	 (if no-inheritance (member type (org-export-backend-blocks b))
+	   (while (and b (not (member type (org-export-backend-blocks b))))
+	     (setq b (org-export-get-backend (org-export-backend-parent b))))
+	   b))))
+
+
+;;;; For Src Blocks
 ;;
 ;; `org-export-get-loc' counts number of code lines accumulated in
 ;; src-block or example-block elements with a "+n" switch until
diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el
index 759e7a1e0..42e1bbe71 100644
--- a/testing/lisp/test-ox.el
+++ b/testing/lisp/test-ox.el
@@ -1890,6 +1890,68 @@ Another text. (ref:text)
 
 
 
+;;; Special blocks
+
+(ert-deftest test-org-export/raw-special-block-p ()
+  "Test `org-export-raw-special-block-p' specifications."
+  ;; Standard test.
+  (should
+   (org-test-with-parsed-data "#+BEGIN_FOO\nContents\n#+END_FOO"
+     (let ((info (org-combine-plists
+		  info (list :back-end
+			     (org-export-create-backend :blocks '("FOO"))))))
+       (org-export-raw-special-block-p
+	(org-element-map tree 'special-block #'identity info t) info))))
+  (should-not
+   (org-test-with-parsed-data "#+BEGIN_BAR\nContents\n#+END_BAR"
+     (let ((info (org-combine-plists
+		  info (list :back-end
+			     (org-export-create-backend :blocks '("FOO"))))))
+       (org-export-raw-special-block-p
+	(org-element-map tree 'special-block #'identity info t) info))))
+  ;; Check is not case-sensitive.
+  (should
+   (org-test-with-parsed-data "#+begin_foo\nContents\n#+end_foo"
+     (let ((info (org-combine-plists
+		  info (list :back-end
+			     (org-export-create-backend :blocks '("FOO"))))))
+       (org-export-raw-special-block-p
+	(org-element-map tree 'special-block #'identity info t) info))))
+  ;; Test inheritance.
+  (should
+   (org-test-with-parsed-data "#+BEGIN_FOO\nContents\n#+END_FOO"
+     (let* ((org-export--registered-backends
+	     (list (org-export-create-backend :name 'b1 :blocks '("FOO"))))
+	    (info (org-combine-plists
+		   info (list :back-end
+			      (org-export-create-backend :parent 'b1
+							 :blocks '("BAR"))))))
+       (org-export-raw-special-block-p
+	(org-element-map tree 'special-block #'identity info t) info))))
+  (should-not
+   (org-test-with-parsed-data "#+BEGIN_BAZ\nContents\n#+END_BAZ"
+     (let* ((org-export--registered-backends
+	     (list (org-export-create-backend :name 'b1 :blocks '("FOO"))))
+	    (info (org-combine-plists
+		   info (list :back-end
+			      (org-export-create-backend :parent 'b1
+							 :blocks '("BAR"))))))
+       (org-export-raw-special-block-p
+	(org-element-map tree 'special-block #'identity info t) info))))
+  ;; With optional argument, ignore inheritance.
+  (should-not
+   (org-test-with-parsed-data "#+BEGIN_FOO\nContents\n#+END_FOO"
+     (let* ((org-export--registered-backends
+	     (list (org-export-create-backend :name 'b1 :blocks '("FOO"))))
+	    (info (org-combine-plists
+		   info (list :back-end
+			      (org-export-create-backend :parent 'b1
+							 :blocks '("BAR"))))))
+       (org-export-raw-special-block-p
+	(org-element-map tree 'special-block #'identity info t) info t)))))
+
+
+
 ;;; Src-block and example-block
 
 (ert-deftest test-org-export/unravel-code ()
-- 
2.11.4.GIT