From b5b08a7f52fde0cb2aa3c6cb8af67cbcb4d27531 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 10 Nov 2015 23:38:04 +0100 Subject: [PATCH] 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 --- lisp/ox.el | 71 +++++++++++++++-------------- testing/lisp/test-ox.el | 98 +++++++++++++++++++---------------------- 2 files changed, 81 insertions(+), 88 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index c897b1a66..0a212eb10 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -1774,35 +1774,39 @@ for a footnotes section." "List headlines and inlinetasks with a select tag in their tree. DATA is parsed data as returned by `org-element-parse-buffer'. INFO is a plist holding export options." - (letrec ((selected-trees) - (walk-data - (lambda (data genealogy) - (let ((type (org-element-type data))) - (cond - ((memq type '(headline inlinetask)) - (let ((tags (org-element-property :tags data))) - (if (cl-loop for tag in (plist-get info :select-tags) - thereis (member tag tags)) - ;; When a select tag is found, mark full - ;; genealogy and every headline within the - ;; tree as acceptable. - (setq selected-trees - (append - genealogy - (org-element-map data '(headline inlinetask) - #'identity) - selected-trees)) - ;; If at a headline, continue searching in tree, - ;; recursively. - (when (eq type 'headline) - (dolist (el (org-element-contents data)) - (funcall walk-data el (cons data genealogy))))))) - ((or (eq type 'org-data) - (memq type org-element-greater-elements)) - (dolist (el (org-element-contents data)) - (funcall walk-data el genealogy)))))))) - (funcall walk-data data nil) - selected-trees)) + (let ((select (plist-get info :select-tags))) + (if (cl-some (lambda (tag) (member tag select)) (plist-get info :filetags)) + ;; If FILETAGS contains a select tag, every headline or + ;; inlinetask is returned. + (org-element-map data '(headline inlinetask) #'identity) + (letrec ((selected-trees) + (walk-data + (lambda (data genealogy) + (let ((type (org-element-type data))) + (cond + ((memq type '(headline inlinetask)) + (let ((tags (org-element-property :tags data))) + (if (cl-some (lambda (tag) (member tag select)) tags) + ;; When a select tag is found, mark full + ;; genealogy and every headline within the + ;; tree as acceptable. + (setq selected-trees + (append + genealogy + (org-element-map data '(headline inlinetask) + #'identity) + selected-trees)) + ;; If at a headline, continue searching in + ;; tree, recursively. + (when (eq type 'headline) + (dolist (el (org-element-contents data)) + (funcall walk-data el (cons data genealogy))))))) + ((or (eq type 'org-data) + (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) "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-type (org-element-property :todo-type blob)) (archived (plist-get options :with-archived-trees)) - (tags (org-element-property :tags blob))) + (tags (org-export-get-tags blob options nil t))) (or (and (eq (org-element-type blob) 'inlinetask) (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 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. 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 and FILETAGS keywords." (cl-remove-if - (lambda (tag) (or (member tag (plist-get info :select-tags)) - (member tag (plist-get info :exclude-tags)) - (member tag tags))) + (lambda (tag) (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))) diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index 72ef068d0..e48979bfe 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -406,27 +406,39 @@ Paragraph" (org-test-with-temp-text "* Head1 :noexp:" (org-export-as (org-test-default-backend) 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. (should - (equal "* H2\n** Sub :exp:\n*** Sub Sub\n" - (org-test-with-temp-text "* H1\n* H2\n** Sub :exp:\n*** Sub Sub\n* H3" + (equal (org-test-with-temp-text "* H1\n* H2\n** Sub :exp:\n*** Sub Sub\n* H3" (let ((org-tags-column 0)) (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 ;; headline, if any. (should - (equal "* H1 :exp:\nBody\n" - (org-test-with-temp-text "First section\n* H1 :exp:\nBody" + (equal (org-test-with-temp-text "First section\n* H1 :exp:\nBody" (let ((org-tags-column 0)) (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 - (equal "* H1 :exp:\n" - (org-test-with-temp-text "* H1 :exp:\nBody" + (equal (org-test-with-temp-text "* H1 :exp:\nBody" (let ((org-tags-column 0)) (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. (should (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 () "Test `org-export-get-tags' specifications." - (let ((org-export-exclude-tags '("noexport")) - (org-export-select-tags '("export"))) - ;; Standard test: tags which are not a select tag, an exclude tag, - ;; or specified as optional argument shouldn't be ignored. - (should - (org-test-with-parsed-data "* Headline :tag:" - (org-export-get-tags (org-element-map tree 'headline 'identity info t) - info))) - ;; Exclude tags are removed. - (should-not - (org-test-with-parsed-data "* Headline :noexport:" - (org-export-get-tags (org-element-map tree 'headline 'identity info t) - info))) - ;; Select tags are removed. - (should-not - (org-test-with-parsed-data "* Headline :export:" - (org-export-get-tags (org-element-map tree 'headline 'identity info t) - info))) - (should - (equal - '("tag") - (org-test-with-parsed-data "* Headline :tag:export:" - (org-export-get-tags (org-element-map tree 'headline 'identity info t) - info)))) - ;; Tags provided in the optional argument are also ignored. - (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)))))) + ;; Standard test: tags which are not a select tag, an exclude tag, + ;; or specified as optional argument shouldn't be ignored. + (should + (org-test-with-parsed-data "* Headline :tag:" + (org-export-get-tags (org-element-map tree 'headline 'identity info t) + info))) + ;; Tags provided in the optional argument are ignored. + (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 () "Test`org-export-get-node-property' specifications."