diff options
author | Nicolas Goaziou <n.goaziou@gmail.com> | 2012-05-26 11:04:29 +0200 |
---|---|---|
committer | Nicolas Goaziou <n.goaziou@gmail.com> | 2012-05-26 13:51:55 +0200 |
commit | 68744bf19f58c52ad984d1a36cedc5573bb112e8 (patch) | |
tree | f02420014ab5b21b0520f0d6aa7153cc1e4bb851 | |
parent | 2a7321f70aa818b2c968b5b4ff14f7ec1a8851c6 (diff) | |
download | org-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.el | 36 | ||||
-rw-r--r-- | testing/lisp/test-org-export.el | 12 |
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: |