forked from mirrors/org-mode
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.
This commit is contained in:
parent
2a7321f70a
commit
68744bf19f
|
@ -1498,11 +1498,8 @@ associated numbering \(in the shape of a list of numbers\)."
|
||||||
|
|
||||||
(defun org-export-populate-ignore-list (data options)
|
(defun org-export-populate-ignore-list (data options)
|
||||||
"Return list of elements and objects to ignore during export.
|
"Return list of elements and objects to ignore during export.
|
||||||
|
|
||||||
DATA is the parse tree to traverse. OPTIONS is the plist holding
|
DATA is the parse tree to traverse. OPTIONS is the plist holding
|
||||||
export options.
|
export options."
|
||||||
|
|
||||||
Return elements or objects to ignore as a list."
|
|
||||||
(let (ignore
|
(let (ignore
|
||||||
(walk-data
|
(walk-data
|
||||||
(function
|
(function
|
||||||
|
@ -1537,28 +1534,31 @@ INFO is a plist holding export options."
|
||||||
(function
|
(function
|
||||||
(lambda (data genealogy)
|
(lambda (data genealogy)
|
||||||
(case (org-element-type data)
|
(case (org-element-type data)
|
||||||
(org-data
|
(org-data (mapc (lambda (el) (funcall walk-data el genealogy))
|
||||||
(funcall walk-data (org-element-contents data) genealogy))
|
(org-element-contents data)))
|
||||||
(headline
|
(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)
|
(if (loop for tag in (plist-get info :select-tags)
|
||||||
thereis (member tag tags))
|
thereis (member tag tags))
|
||||||
;; When a select tag is found, mark as acceptable
|
;; When a select tag is found, mark full
|
||||||
;; full genealogy and every headline within the
|
;; genealogy and every headline within the tree
|
||||||
;; tree.
|
;; as acceptable.
|
||||||
(setq selected-trees
|
(setq selected-trees
|
||||||
(append
|
(append
|
||||||
(cons data genealogy)
|
genealogy
|
||||||
(org-element-map data 'headline 'identity)
|
(org-element-map data 'headline 'identity)
|
||||||
selected-trees))
|
selected-trees))
|
||||||
;; Else, continue searching in tree, recursively.
|
;; 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))
|
(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.
|
"Non-nil when element or object BLOB should be skipped during export.
|
||||||
OPTIONS is the plist holding export options. SELECT-TAGS, when
|
OPTIONS is the plist holding export options. SELECTED, when
|
||||||
non-nil, is a list of tags marking a subtree as exportable."
|
non-nil, is a list of headlines belonging to a tree with a select
|
||||||
|
tag."
|
||||||
(case (org-element-type blob)
|
(case (org-element-type blob)
|
||||||
;; Check headline.
|
;; Check headline.
|
||||||
(headline
|
(headline
|
||||||
|
@ -1571,9 +1571,9 @@ non-nil, is a list of tags marking a subtree as exportable."
|
||||||
;; Ignore subtrees with an exclude tag.
|
;; Ignore subtrees with an exclude tag.
|
||||||
(loop for k in (plist-get options :exclude-tags)
|
(loop for k in (plist-get options :exclude-tags)
|
||||||
thereis (member k tags))
|
thereis (member k tags))
|
||||||
;; Ignore subtrees without a select tag, when such tag is
|
;; When a select tag is present in the buffer, ignore any tree
|
||||||
;; found in the buffer.
|
;; without it.
|
||||||
(member blob select-tags)
|
(and selected (not (member blob selected)))
|
||||||
;; Ignore commented sub-trees.
|
;; Ignore commented sub-trees.
|
||||||
(org-element-property :commentedp blob)
|
(org-element-property :commentedp blob)
|
||||||
;; Ignore archived subtrees if `:with-archived-trees' is nil.
|
;; Ignore archived subtrees if `:with-archived-trees' is nil.
|
||||||
|
|
|
@ -123,14 +123,16 @@ already filled in `info'."
|
||||||
;; Test include tags.
|
;; Test include tags.
|
||||||
(org-test-with-temp-text "
|
(org-test-with-temp-text "
|
||||||
* Head1
|
* Head1
|
||||||
** Sub-Head1.1 :export:
|
* Head2
|
||||||
*** Sub-Head1.1.1
|
** Sub-Head2.1 :export:
|
||||||
|
*** Sub-Head2.1.1
|
||||||
* Head2"
|
* Head2"
|
||||||
(org-test-with-backend test
|
(org-test-with-backend test
|
||||||
(should
|
(should
|
||||||
(string-match
|
(equal
|
||||||
"\\* Head1\n\\*\\* Sub-Head1.1[ \t]+:export:\n\\*\\*\\* Sub-Head1.1.1\n"
|
"* Head2\n** Sub-Head2.1 :export:\n*** Sub-Head2.1.1\n"
|
||||||
(org-export-as 'test nil nil nil '(:select-tags ("export")))))))
|
(let ((org-tags-column 0))
|
||||||
|
(org-export-as 'test nil nil nil '(:select-tags ("export"))))))))
|
||||||
;; Test mixing include tags and exclude tags.
|
;; Test mixing include tags and exclude tags.
|
||||||
(org-test-with-temp-text "
|
(org-test-with-temp-text "
|
||||||
* Head1 :export:
|
* Head1 :export:
|
||||||
|
|
Loading…
Reference in a new issue