Browse Source

ox: Fix select tags and exclude tags and tags hierarchy

* lisp/ox.el (org-export--selected-trees): Expand select tags groups.
(org-export--prune-tree): Expand exclude tags groups.
(org-export--skip-p): Change signature.

* testing/lisp/test-ox.el (test-org-export/handle-options): Add tests.

Reported-by: Pierre-Luc Gauthier <p.luc.gauthier@gmail.com>
<http://lists.gnu.org/r/emacs-orgmode/2018-02/msg00039.html>
Nicolas Goaziou 1 year ago
parent
commit
19dcbab6f0
2 changed files with 34 additions and 6 deletions
  1. 11 6
      lisp/ox.el
  2. 23 0
      testing/lisp/test-ox.el

+ 11 - 6
lisp/ox.el

@@ -1781,7 +1781,8 @@ 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."
-  (let ((select (plist-get info :select-tags)))
+  (let ((select (cl-mapcan (lambda (tag) (org-tags-expand tag t))
+			   (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.
@@ -1815,11 +1816,13 @@ INFO is a plist holding export options."
 	(funcall walk-data data nil)
 	selected-trees))))
 
-(defun org-export--skip-p (datum options selected)
+(defun org-export--skip-p (datum options selected excluded)
   "Non-nil when element or object DATUM should be skipped during export.
 OPTIONS is the plist holding export options.  SELECTED, when
 non-nil, is a list of headlines or inlinetasks belonging to
-a tree with a select tag."
+a tree with a select tag.  EXCLUDED is a list of tags, as
+strings.  Any headline or inlinetask marked with one of those is
+not exported."
   (cl-case (org-element-type datum)
     ((comment comment-block)
      ;; Skip all comments and comment blocks.  Make to keep maximum
@@ -1858,8 +1861,7 @@ a tree with a select tag."
 	(and (eq (org-element-type datum) 'inlinetask)
 	     (not (plist-get options :with-inlinetasks)))
 	;; Ignore subtrees with an exclude tag.
-	(cl-loop for k in (plist-get options :exclude-tags)
-		 thereis (member k tags))
+	(cl-some (lambda (tag) (member tag excluded)) tags)
 	;; When a select tag is present in the buffer, ignore any tree
 	;; without it.
 	(and selected (not (memq datum selected)))
@@ -2713,6 +2715,9 @@ from tree."
   (letrec ((ignore nil)
 	   ;; First find trees containing a select tag, if any.
 	   (selected (org-export--selected-trees data info))
+	   ;; List tags that prevent export of headlines.
+	   (excluded (cl-mapcan (lambda (tag) (org-tags-expand tag t))
+				(plist-get info :exclude-tags)))
 	   (walk-data
 	    (lambda (data)
 	      ;; Prune non-exportable elements and objects from tree.
@@ -2721,7 +2726,7 @@ from tree."
 	      ;; accessed during export.
 	      (when data
 		(let ((type (org-element-type data)))
-		  (if (org-export--skip-p data info selected)
+		  (if (org-export--skip-p data info selected excluded)
 		      (if (memq type '(table-cell table-row)) (push data ignore)
 			(org-element-extract-element data))
 		    (if (and (eq type 'headline)

+ 23 - 0
testing/lisp/test-ox.el

@@ -445,6 +445,17 @@ Paragraph"
 	    (org-test-with-temp-text "#+FILETAGS: noexp\n* Head1"
 	      (org-export-as (org-test-default-backend)
 			     nil nil nil '(:exclude-tags ("noexp")))))))
+  ;; Excluding a tag excludes its whole group.
+  (should
+   (equal ""
+	  (let (org-export-filter-body-functions
+		org-export-filter-final-output-functions)
+	    (org-test-with-temp-text "* Head1 :baz:"
+	      (let ((org-tag-alist '((:startgrouptag)
+				     ("foo") (:grouptags) ("bar") ("baz")
+				     (:endgrouptag))))
+		(org-export-as (org-test-default-backend)
+			       nil nil nil '(:exclude-tags ("foo"))))))))
   ;; Test include tags for headlines and inlinetasks.
   (should
    (equal (org-test-with-temp-text "* H1\n* H2\n** Sub :exp:\n*** Sub Sub\n* H3"
@@ -452,6 +463,18 @@ Paragraph"
 	      (org-export-as (org-test-default-backend)
 			     nil nil nil '(:select-tags ("exp")))))
 	  "* H2\n** Sub :exp:\n*** Sub Sub\n"))
+  ;; Including a tag includes its whole group.
+  (should
+   (string-match-p
+    "\\`\\* H2"
+    (let (org-export-filter-body-functions
+	  org-export-filter-final-output-functions)
+      (org-test-with-temp-text "* H1\n* H2 :bar:"
+	(let ((org-tag-alist '((:startgrouptag)
+			       ("foo") (:grouptags) ("bar") ("baz")
+			       (:endgrouptag))))
+	  (org-export-as (org-test-default-backend)
+			 nil nil nil '(:select-tags ("foo"))))))))
   ;; If there is an include tag, ignore the section before the first
   ;; headline, if any.
   (should