org-export: Add tag inheritance to `org-export-get-tags'

* contrib/lisp/org-export.el (org-export-get-tags): Add optional tag
  inheritance.
* testing/lisp/test-org-export.el: Add test.
This commit is contained in:
Nicolas Goaziou 2012-10-14 13:19:12 +02:00
parent f287ab418d
commit c1c0c70c89
2 changed files with 31 additions and 7 deletions

View File

@ -3157,7 +3157,7 @@ INFO is a plist used as a communication channel."
(pop roman)))
res)))
(defun org-export-get-tags (element info &optional tags)
(defun org-export-get-tags (element info &optional tags inherited)
"Return list of tags associated to ELEMENT.
ELEMENT has either an `headline' or an `inlinetask' type. INFO
@ -3167,11 +3167,27 @@ Select tags (see `org-export-select-tags') and exclude tags (see
`org-export-exclude-tags') are removed from the list.
When non-nil, optional argument TAGS should be a list of strings.
Any tag belonging to this list will also be removed."
(org-remove-if (lambda (tag) (or (member tag (plist-get info :select-tags))
(member tag (plist-get info :exclude-tags))
(member tag tags)))
(org-element-property :tags element)))
Any tag belonging to this list will also be removed.
When optional argument INHERITED is non-nil, tags can also be
inherited from parent headlines.."
(org-remove-if
(lambda (tag) (or (member tag (plist-get info :select-tags))
(member tag (plist-get info :exclude-tags))
(member tag tags)))
(if (not inherited) (org-element-property :tags element)
;; Build complete list of inherited tags.
(let ((current-tag-list (org-element-property :tags element)))
(mapc
(lambda (parent)
(mapc
(lambda (tag)
(when (and (memq (org-element-type parent) '(headline inlinetask))
(not (member tag current-tag-list)))
(push tag current-tag-list)))
(org-element-property :tags parent)))
(org-export-get-genealogy element))
current-tag-list))))
(defun org-export-get-node-property (property blob &optional inherited)
"Return node PROPERTY value for BLOB.

View File

@ -750,7 +750,15 @@ Paragraph[fn:1]"
(should-not
(org-test-with-parsed-data "* Headline :ignore:"
(org-export-get-tags (org-element-map tree 'headline 'identity info t)
info '("ignore"))))))
info '("ignore"))))
;; Allow tag inheritance.
(should
(equal
'(("tag") ("tag"))
(org-test-with-parsed-data "* Headline :tag:\n** Sub-heading"
(org-element-map
tree 'headline
(lambda (hl) (org-export-get-tags hl info nil t)) info))))))
(ert-deftest test-org-export/get-node-property ()
"Test`org-export-get-node-property' specifications."