summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2012-11-02 12:44:46 (GMT)
committer Nicolas Goaziou <n.goaziou@gmail.com>2012-11-02 12:44:46 (GMT)
commit22ac03bee5ac7bc6662f5f0be3b3b3d8e7a6a2fd (patch)
tree840d2337e3749185b8a5e18ff095c81629c3f896
parent869e0fa73d074459a75ed6072899572c045f7930 (diff)
downloadorg-mode-22ac03bee5ac7bc6662f5f0be3b3b3d8e7a6a2fd.zip
org-mode-22ac03bee5ac7bc6662f5f0be3b3b3d8e7a6a2fd.tar.gz
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.
-rw-r--r--contrib/lisp/org-export.el29
-rw-r--r--testing/lisp/test-org-export.el43
2 files changed, 72 insertions, 0 deletions
diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
index 2e28c0d..e035baa 100644
--- a/contrib/lisp/org-export.el
+++ b/contrib/lisp/org-export.el
@@ -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."
diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el
index 719548f..735fe1c 100644
--- a/testing/lisp/test-org-export.el
+++ b/testing/lisp/test-org-export.el
@@ -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.