Browse Source

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.
Nicolas Goaziou 10 years ago
parent
commit
2160b3d242
2 changed files with 85 additions and 2 deletions
  1. 23 2
      lisp/ox.el
  2. 62 0
      testing/lisp/test-ox.el

+ 23 - 2
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

+ 62 - 0
testing/lisp/test-ox.el

@@ -1889,6 +1889,68 @@ Another text. (ref:text)
 	 (lambda (link) (org-export-resolve-radio-link link info)) info t)))))
 
 
+
+;;; 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