From 22ac03bee5ac7bc6662f5f0be3b3b3d8e7a6a2fd Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <n.goaziou@gmail.com>
Date: Fri, 2 Nov 2012 13:44:46 +0100
Subject: [PATCH] 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.
---
 contrib/lisp/org-export.el      | 29 ++++++++++++++++++++++
 testing/lisp/test-org-export.el | 43 +++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+)

diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
index 2e28c0dd6..e035baac4 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 719548f20..735fe1c2f 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.