forked from mirrors/org-mode
org-export: Add a function to retrieve category of an element or object
* contrib/lisp/org-export.el (org-export-get-category): New function. * testing/lisp/test-org-export.el: Add tests.
This commit is contained in:
parent
869e0fa73d
commit
22ac03bee5
|
@ -3240,6 +3240,35 @@ Return value is a string or nil."
|
||||||
(throw 'found (org-element-property property parent)))
|
(throw 'found (org-element-property property parent)))
|
||||||
(setq parent (org-element-property :parent parent))))))))
|
(setq parent (org-element-property :parent parent))))))))
|
||||||
|
|
||||||
|
(defun org-export-get-category (blob info)
|
||||||
|
"Return category for element or object BLOB.
|
||||||
|
|
||||||
|
INFO is a plist used as a communication channel.
|
||||||
|
|
||||||
|
CATEGORY is automatically inherited from a parent headline, from
|
||||||
|
#+CATEGORY: keyword or created out of original file name. If all
|
||||||
|
fail, the fall-back value is \"???\"."
|
||||||
|
(or (let ((headline (if (eq (org-element-type blob) 'headline) blob
|
||||||
|
(org-export-get-parent-headline blob))))
|
||||||
|
;; Almost like `org-export-node-property', but we cannot trust
|
||||||
|
;; `plist-member' as every headline has a `:category'
|
||||||
|
;; property, even if nil.
|
||||||
|
(let ((parent headline) value)
|
||||||
|
(catch 'found
|
||||||
|
(while parent
|
||||||
|
(let ((category (org-element-property :category parent)))
|
||||||
|
(and category (throw 'found category)))
|
||||||
|
(setq parent (org-element-property :parent parent))))))
|
||||||
|
(org-element-map
|
||||||
|
(plist-get info :parse-tree) 'keyword
|
||||||
|
(lambda (kwd)
|
||||||
|
(when (equal (org-element-property :key kwd) "CATEGORY")
|
||||||
|
(org-element-property :value kwd)))
|
||||||
|
info 'first-match)
|
||||||
|
(let ((file (plist-get info :input-file)))
|
||||||
|
(and file (file-name-sans-extension (file-name-nondirectory file))))
|
||||||
|
"???"))
|
||||||
|
|
||||||
(defun org-export-first-sibling-p (headline info)
|
(defun org-export-first-sibling-p (headline info)
|
||||||
"Non-nil when HEADLINE is the first sibling in its sub-tree.
|
"Non-nil when HEADLINE is the first sibling in its sub-tree.
|
||||||
INFO is a plist used as a communication channel."
|
INFO is a plist used as a communication channel."
|
||||||
|
|
|
@ -808,6 +808,49 @@ Paragraph[fn:1]"
|
||||||
(org-export-get-node-property
|
(org-export-get-node-property
|
||||||
:prop (org-element-map tree 'paragraph 'identity nil t)))))
|
:prop (org-element-map tree 'paragraph 'identity nil t)))))
|
||||||
|
|
||||||
|
(ert-deftest test-org-export/get-category ()
|
||||||
|
"Test `org-export-get-category' specifications."
|
||||||
|
;; Standard test.
|
||||||
|
(should
|
||||||
|
(equal "value"
|
||||||
|
(org-test-with-parsed-data "* Headline
|
||||||
|
:PROPERTIES:
|
||||||
|
:CATEGORY: value
|
||||||
|
:END:"
|
||||||
|
(org-export-get-category
|
||||||
|
(org-element-map tree 'headline 'identity nil t) info))))
|
||||||
|
;; Test inheritance from a parent headline.
|
||||||
|
(should
|
||||||
|
(equal '("value" "value")
|
||||||
|
(org-test-with-parsed-data "* Headline1
|
||||||
|
:PROPERTIES:
|
||||||
|
:CATEGORY: value
|
||||||
|
:END:
|
||||||
|
** Headline2"
|
||||||
|
(org-element-map
|
||||||
|
tree 'headline
|
||||||
|
(lambda (hl) (org-export-get-category hl info)) info))))
|
||||||
|
;; Test inheritance from #+CATEGORY keyword
|
||||||
|
(should
|
||||||
|
(equal "value"
|
||||||
|
(org-test-with-parsed-data "#+CATEGORY: value
|
||||||
|
* Headline"
|
||||||
|
(org-export-get-category
|
||||||
|
(org-element-map tree 'headline 'identity nil t) info))))
|
||||||
|
;; Test inheritance from file name.
|
||||||
|
(should
|
||||||
|
(equal "test"
|
||||||
|
(org-test-with-parsed-data "* Headline"
|
||||||
|
(let ((info (plist-put info :input-file "~/test.org")))
|
||||||
|
(org-export-get-category
|
||||||
|
(org-element-map tree 'headline 'identity nil t) info)))))
|
||||||
|
;; Fall-back value.
|
||||||
|
(should
|
||||||
|
(equal "???"
|
||||||
|
(org-test-with-parsed-data "* Headline"
|
||||||
|
(org-export-get-category
|
||||||
|
(org-element-map tree 'headline 'identity nil t) info)))))
|
||||||
|
|
||||||
(ert-deftest test-org-export/first-sibling-p ()
|
(ert-deftest test-org-export/first-sibling-p ()
|
||||||
"Test `org-export-first-sibling-p' specifications."
|
"Test `org-export-first-sibling-p' specifications."
|
||||||
;; Standard test.
|
;; Standard test.
|
||||||
|
|
Loading…
Reference in a new issue