summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2012-05-26 11:04:29 +0200
committerNicolas Goaziou <n.goaziou@gmail.com>2012-05-26 13:51:55 +0200
commit68744bf19f58c52ad984d1a36cedc5573bb112e8 (patch)
treef02420014ab5b21b0520f0d6aa7153cc1e4bb851
parent2a7321f70aa818b2c968b5b4ff14f7ec1a8851c6 (diff)
downloadorg-mode-68744bf19f58c52ad984d1a36cedc5573bb112e8.tar.gz
org-export: Fix selective export when a select tag is present
* contrib/lisp/org-export.el (org-export-populate-ignore-list): Fix docstring. (org-export--selected-trees): Correctly search for headlines with a select tag. (org-export--skip-p): Fix selective export when a select tag is present in the buffer. * testing/lisp/test-org-export.el: Update tests.
-rw-r--r--contrib/lisp/org-export.el36
-rw-r--r--testing/lisp/test-org-export.el12
2 files changed, 25 insertions, 23 deletions
diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
index 74b60b5..e9fa2a2 100644
--- a/contrib/lisp/org-export.el
+++ b/contrib/lisp/org-export.el
@@ -1498,11 +1498,8 @@ associated numbering \(in the shape of a list of numbers\)."
(defun org-export-populate-ignore-list (data options)
"Return list of elements and objects to ignore during export.
-
DATA is the parse tree to traverse. OPTIONS is the plist holding
-export options.
-
-Return elements or objects to ignore as a list."
+export options."
(let (ignore
(walk-data
(function
@@ -1537,28 +1534,31 @@ INFO is a plist holding export options."
(function
(lambda (data genealogy)
(case (org-element-type data)
- (org-data
- (funcall walk-data (org-element-contents data) genealogy))
+ (org-data (mapc (lambda (el) (funcall walk-data el genealogy))
+ (org-element-contents data)))
(headline
- (let ((tags (org-element-property :tags headline)))
+ (let ((tags (org-element-property :tags data)))
(if (loop for tag in (plist-get info :select-tags)
thereis (member tag tags))
- ;; When a select tag is found, mark as acceptable
- ;; full genealogy and every headline within the
- ;; tree.
+ ;; When a select tag is found, mark full
+ ;; genealogy and every headline within the tree
+ ;; as acceptable.
(setq selected-trees
(append
- (cons data genealogy)
+ genealogy
(org-element-map data 'headline 'identity)
selected-trees))
;; Else, continue searching in tree, recursively.
- (funcall walk-data data (cons data genealogy))))))))))
+ (mapc
+ (lambda (el) (funcall walk-data el (cons data genealogy)))
+ (org-element-contents data))))))))))
(funcall walk-data data nil) selected-trees))
-(defun org-export--skip-p (blob options select-tags)
+(defun org-export--skip-p (blob options selected)
"Non-nil when element or object BLOB should be skipped during export.
-OPTIONS is the plist holding export options. SELECT-TAGS, when
-non-nil, is a list of tags marking a subtree as exportable."
+OPTIONS is the plist holding export options. SELECTED, when
+non-nil, is a list of headlines belonging to a tree with a select
+tag."
(case (org-element-type blob)
;; Check headline.
(headline
@@ -1571,9 +1571,9 @@ non-nil, is a list of tags marking a subtree as exportable."
;; Ignore subtrees with an exclude tag.
(loop for k in (plist-get options :exclude-tags)
thereis (member k tags))
- ;; Ignore subtrees without a select tag, when such tag is
- ;; found in the buffer.
- (member blob select-tags)
+ ;; When a select tag is present in the buffer, ignore any tree
+ ;; without it.
+ (and selected (not (member blob selected)))
;; Ignore commented sub-trees.
(org-element-property :commentedp blob)
;; Ignore archived subtrees if `:with-archived-trees' is nil.
diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el
index 78a6b08..e1e77dc 100644
--- a/testing/lisp/test-org-export.el
+++ b/testing/lisp/test-org-export.el
@@ -123,14 +123,16 @@ already filled in `info'."
;; Test include tags.
(org-test-with-temp-text "
* Head1
-** Sub-Head1.1 :export:
-*** Sub-Head1.1.1
+* Head2
+** Sub-Head2.1 :export:
+*** Sub-Head2.1.1
* Head2"
(org-test-with-backend test
(should
- (string-match
- "\\* Head1\n\\*\\* Sub-Head1.1[ \t]+:export:\n\\*\\*\\* Sub-Head1.1.1\n"
- (org-export-as 'test nil nil nil '(:select-tags ("export")))))))
+ (equal
+ "* Head2\n** Sub-Head2.1 :export:\n*** Sub-Head2.1.1\n"
+ (let ((org-tags-column 0))
+ (org-export-as 'test nil nil nil '(:select-tags ("export"))))))))
;; Test mixing include tags and exclude tags.
(org-test-with-temp-text "
* Head1 :export: