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)))
|
||||
(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)
|
||||
"Non-nil when HEADLINE is the first sibling in its sub-tree.
|
||||
INFO is a plist used as a communication channel."
|
||||
|
|
|
@ -808,6 +808,49 @@ Paragraph[fn:1]"
|
|||
(org-export-get-node-property
|
||||
: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 ()
|
||||
"Test `org-export-first-sibling-p' specifications."
|
||||
;; Standard test.
|
||||
|
|
Loading…
Reference in New Issue