Преглед изворни кода

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>
Nicolas Goaziou пре 9 година
родитељ
комит
b5b08a7f52
2 измењених фајлова са 81 додато и 88 уклоњено
  1. 35 36
      lisp/ox.el
  2. 46 52
      testing/lisp/test-ox.el

+ 35 - 36
lisp/ox.el

@@ -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)
-	   (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)
 (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))
-		(member tag (plist-get info :exclude-tags))
-		(member tag tags)))
+   (lambda (tag) (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)))

+ 46 - 52
testing/lisp/test-ox.el

@@ -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"
-	  (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))
 	    (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"
-	  (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))
 	    (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"
-	  (org-test-with-temp-text "* H1 :exp:\nBody"
+   (equal (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"))
-	(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 ()
 (ert-deftest test-org-export/get-node-property ()
   "Test`org-export-get-node-property' specifications."
   "Test`org-export-get-node-property' specifications."