diff --git a/lisp/ox.el b/lisp/ox.el index db5a3c481..236ce8426 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -4236,8 +4236,29 @@ objects of the same type." ((funcall predicate el info) (incf counter) nil))) info 'first-match))))) +;;;; 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. -;;;; For Src-Blocks +(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 234032ed5..060088476 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -2143,6 +2143,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