tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

ox: Look for export and noexport tags in FILETAGS 

* lisp/ox.el (org-export--selected-trees):
(org-export--skip-p): Check also FILETAGS.
* lisp/ox.el (org-export-get-tags): Also report export and noexport
  tags.

Reported-by: Michael Welle <mwe012008@gmx.net>
<http://permalink.gmane.org/gmane.emacs.orgmode/102754>
This commit is contained in:
Nicolas Goaziou 2015-11-10 23:38:04 +01:00
parent c993007eb6
commit b5b08a7f52
2 changed files with 81 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
lisp/ox.el
View File

@ -1774,35 +1774,39 @@ for a footnotes section."
"List headlines and inlinetasks with a select tag in their tree. "List headlines and inlinetasks with a select tag in their tree.
DATA is parsed data as returned by `org-element-parse-buffer'. DATA is parsed data as returned by `org-element-parse-buffer'.
INFO is a plist holding export options." INFO is a plist holding export options."
(letrec ((selected-trees) (let ((select (plist-get info :select-tags)))
(walk-data (if (cl-some (lambda (tag) (member tag select)) (plist-get info :filetags))
(lambda (data genealogy) ;; If FILETAGS contains a select tag, every headline or
(let ((type (org-element-type data))) ;; inlinetask is returned.
(cond (org-element-map data '(headline inlinetask) #'identity)
((memq type '(headline inlinetask)) (letrec ((selected-trees)
(let ((tags (org-element-property :tags data))) (walk-data
(if (cl-loop for tag in (plist-get info :select-tags) (lambda (data genealogy)
thereis (member tag tags)) (let ((type (org-element-type data)))
;; When a select tag is found, mark full (cond
;; genealogy and every headline within the ((memq type '(headline inlinetask))
;; tree as acceptable. (let ((tags (org-element-property :tags data)))
(setq selected-trees (if (cl-some (lambda (tag) (member tag select)) tags)
(append ;; When a select tag is found, mark full
genealogy ;; genealogy and every headline within the
(org-element-map data '(headline inlinetask) ;; tree as acceptable.
#'identity) (setq selected-trees
selected-trees)) (append
;; If at a headline, continue searching in tree, genealogy
;; recursively. (org-element-map data '(headline inlinetask)
(when (eq type 'headline) #'identity)
(dolist (el (org-element-contents data)) selected-trees))
(funcall walk-data el (cons data genealogy))))))) ;; If at a headline, continue searching in
((or (eq type 'org-data) ;; tree, recursively.
(memq type org-element-greater-elements)) (when (eq type 'headline)
(dolist (el (org-element-contents data)) (dolist (el (org-element-contents data))
(funcall walk-data el genealogy)))))))) (funcall walk-data el (cons data genealogy)))))))
(funcall walk-data data nil) ((or (eq type 'org-data)
selected-trees)) (memq type org-element-greater-elements))
(dolist (el (org-element-contents data))
(funcall walk-data el genealogy))))))))
(funcall walk-data data nil)
selected-trees))))
(defun org-export--skip-p (blob options selected) (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.
@ -1831,7 +1835,7 @@ a tree with a select tag."
(todo (org-element-property :todo-keyword blob)) (todo (org-element-property :todo-keyword blob))
(todo-type (org-element-property :todo-type blob)) (todo-type (org-element-property :todo-type blob))
(archived (plist-get options :with-archived-trees)) (archived (plist-get options :with-archived-trees))
(tags (org-element-property :tags blob))) (tags (org-export-get-tags blob options nil t)))
(or (or
(and (eq (org-element-type blob) 'inlinetask) (and (eq (org-element-type blob) 'inlinetask)
(not (plist-get options :with-inlinetasks))) (not (plist-get options :with-inlinetasks)))
@ -3942,18 +3946,13 @@ INFO is a plist used as a communication channel."
ELEMENT has either an `headline' or an `inlinetask' type. INFO ELEMENT has either an `headline' or an `inlinetask' type. INFO
is a plist used as a communication channel. is a plist used as a communication channel.
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. When non-nil, optional argument TAGS should be a list of strings.
Any tag belonging to this list will also be removed. Any tag belonging to this list will also be removed.
When optional argument INHERITED is non-nil, tags can also be When optional argument INHERITED is non-nil, tags can also be
inherited from parent headlines and FILETAGS keywords." inherited from parent headlines and FILETAGS keywords."
(cl-remove-if (cl-remove-if
(lambda (tag) (or (member tag (plist-get info :select-tags)) (lambda (tag) (member tag tags))
(member tag (plist-get info :exclude-tags))
(member tag tags)))
(if (not inherited) (org-element-property :tags element) (if (not inherited) (org-element-property :tags element)
;; Build complete list of inherited tags. ;; Build complete list of inherited tags.
(let ((current-tag-list (org-element-property :tags element))) (let ((current-tag-list (org-element-property :tags element)))

98
testing/lisp/test-ox.el
View File

@ -406,27 +406,39 @@ Paragraph"
(org-test-with-temp-text "* Head1 :noexp:" (org-test-with-temp-text "* Head1 :noexp:"
(org-export-as (org-test-default-backend) (org-export-as (org-test-default-backend)
nil nil nil '(:exclude-tags ("noexp"))))))) nil nil nil '(:exclude-tags ("noexp")))))))
(should
(equal "#+FILETAGS: noexp\n"
(let (org-export-filter-body-functions
org-export-filter-final-output-functions)
(org-test-with-temp-text "#+FILETAGS: noexp\n* Head1"
(org-export-as (org-test-default-backend)
nil nil nil '(:exclude-tags ("noexp")))))))
;; Test include tags for headlines and inlinetasks. ;; Test include tags for headlines and inlinetasks.
(should (should
(equal "* H2\n** Sub :exp:\n*** Sub Sub\n" (equal (org-test-with-temp-text "* H1\n* H2\n** Sub :exp:\n*** Sub Sub\n* H3"
(org-test-with-temp-text "* H1\n* H2\n** Sub :exp:\n*** Sub Sub\n* H3"
(let ((org-tags-column 0)) (let ((org-tags-column 0))
(org-export-as (org-test-default-backend) (org-export-as (org-test-default-backend)
nil nil nil '(:select-tags ("exp"))))))) nil nil nil '(:select-tags ("exp")))))
"* H2\n** Sub :exp:\n*** Sub Sub\n"))
;; If there is an include tag, ignore the section before the first ;; If there is an include tag, ignore the section before the first
;; headline, if any. ;; headline, if any.
(should (should
(equal "* H1 :exp:\nBody\n" (equal (org-test-with-temp-text "First section\n* H1 :exp:\nBody"
(org-test-with-temp-text "First section\n* H1 :exp:\nBody"
(let ((org-tags-column 0)) (let ((org-tags-column 0))
(org-export-as (org-test-default-backend) (org-export-as (org-test-default-backend)
nil nil nil '(:select-tags ("exp"))))))) nil nil nil '(:select-tags ("exp")))))
"* H1 :exp:\nBody\n"))
(should
(equal (org-test-with-temp-text "#+FILETAGS: exp\nFirst section\n* H1\nBody"
(org-export-as (org-test-default-backend)
nil nil nil '(:select-tags ("exp"))))
"* H1\nBody\n"))
(should-not (should-not
(equal "* H1 :exp:\n" (equal (org-test-with-temp-text "* H1 :exp:\nBody"
(org-test-with-temp-text "* H1 :exp:\nBody"
(let ((org-tags-column 0)) (let ((org-tags-column 0))
(org-export-as (org-test-default-backend) (org-export-as (org-test-default-backend)
nil nil nil '(:select-tags ("exp"))))))) nil nil nil '(:select-tags ("exp")))))
"* H1 :exp:\n"))
;; Test mixing include tags and exclude tags. ;; Test mixing include tags and exclude tags.
(should (should
(string-match (string-match
@ -2099,49 +2111,31 @@ Footnotes[fn:2], foot[fn:test], digit only[3], and [fn:inline:anonymous footnote
(ert-deftest test-org-export/get-tags () (ert-deftest test-org-export/get-tags ()
"Test `org-export-get-tags' specifications." "Test `org-export-get-tags' specifications."
(let ((org-export-exclude-tags '("noexport")) ;; Standard test: tags which are not a select tag, an exclude tag,
(org-export-select-tags '("export"))) ;; or specified as optional argument shouldn't be ignored.
;; Standard test: tags which are not a select tag, an exclude tag, (should
;; or specified as optional argument shouldn't be ignored. (org-test-with-parsed-data "* Headline :tag:"
(should (org-export-get-tags (org-element-map tree 'headline 'identity info t)
(org-test-with-parsed-data "* Headline :tag:" info)))
(org-export-get-tags (org-element-map tree 'headline 'identity info t) ;; Tags provided in the optional argument are ignored.
info))) (should-not
;; Exclude tags are removed. (org-test-with-parsed-data "* Headline :ignore:"
(should-not (org-export-get-tags (org-element-map tree 'headline 'identity info t)
(org-test-with-parsed-data "* Headline :noexport:" info '("ignore"))))
(org-export-get-tags (org-element-map tree 'headline 'identity info t) ;; Allow tag inheritance.
info))) (should
;; Select tags are removed. (equal
(should-not '(("tag") ("tag"))
(org-test-with-parsed-data "* Headline :export:" (org-test-with-parsed-data "* Headline :tag:\n** Sub-heading"
(org-export-get-tags (org-element-map tree 'headline 'identity info t) (org-element-map tree 'headline
info))) (lambda (hl) (org-export-get-tags hl info nil t)) info))))
(should ;; Tag inheritance checks FILETAGS keywords.
(equal (should
'("tag") (equal
(org-test-with-parsed-data "* Headline :tag:export:" '(("a" "b" "tag"))
(org-export-get-tags (org-element-map tree 'headline 'identity info t) (org-test-with-parsed-data "#+FILETAGS: :a:b:\n* Headline :tag:"
info)))) (org-element-map tree 'headline
;; Tags provided in the optional argument are also ignored. (lambda (hl) (org-export-get-tags hl info nil t)) info)))))
(should-not
(org-test-with-parsed-data "* Headline :ignore:"
(org-export-get-tags (org-element-map tree 'headline 'identity info t)
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))))
;; Tag inheritance checks FILETAGS keywords.
(should
(equal
'(("a" "b" "tag"))
(org-test-with-parsed-data "#+FILETAGS: :a:b:\n* Headline :tag:"
(org-element-map tree 'headline
(lambda (hl) (org-export-get-tags hl info nil t)) info))))))
(ert-deftest test-org-export/get-node-property () (ert-deftest test-org-export/get-node-property ()
"Test`org-export-get-node-property' specifications." "Test`org-export-get-node-property' specifications."