瀏覽代碼

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.
Nicolas Goaziou 13 年之前
父節點
當前提交
68744bf19f
共有 2 個文件被更改,包括 25 次插入23 次删除
  1. 18 18
      contrib/lisp/org-export.el
  2. 7 5
      testing/lisp/test-org-export.el

+ 18 - 18
contrib/lisp/org-export.el

@@ -1498,11 +1498,8 @@ associated numbering \(in the shape of a list of numbers\)."
 
 (defun org-export-populate-ignore-list (data options)
   "Return list of elements and objects to ignore during export.
-
 DATA is the parse tree to traverse.  OPTIONS is the plist holding
-export options.
-
-Return elements or objects to ignore as a list."
+export options."
   (let (ignore
 	(walk-data
 	 (function
@@ -1537,28 +1534,31 @@ INFO is a plist holding export options."
 	 (function
 	  (lambda (data genealogy)
 	    (case (org-element-type data)
-	      (org-data
-	       (funcall walk-data (org-element-contents data) genealogy))
+	      (org-data (mapc (lambda (el) (funcall walk-data el genealogy))
+			      (org-element-contents data)))
 	      (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)
 			   thereis (member tag tags))
-		     ;; When a select tag is found, mark as acceptable
-		     ;; full genealogy and every headline within the
-		     ;; tree.
+		     ;; When a select tag is found, mark full
+		     ;; genealogy and every headline within the tree
+		     ;; as acceptable.
 		     (setq selected-trees
 			   (append
-			    (cons data genealogy)
+			    genealogy
 			    (org-element-map data 'headline 'identity)
 			    selected-trees))
 		   ;; 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))
 
-(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.
-OPTIONS is the plist holding export options.  SELECT-TAGS, when
-non-nil, is a list of tags marking a subtree as exportable."
+OPTIONS is the plist holding export options.  SELECTED, when
+non-nil, is a list of headlines belonging to a tree with a select
+tag."
   (case (org-element-type blob)
     ;; Check headline.
     (headline
@@ -1571,9 +1571,9 @@ non-nil, is a list of tags marking a subtree as exportable."
 	;; Ignore subtrees with an exclude tag.
 	(loop for k in (plist-get options :exclude-tags)
 	      thereis (member k tags))
-	;; Ignore subtrees without a select tag, when such tag is
-	;; found in the buffer.
-	(member blob select-tags)
+	;; When a select tag is present in the buffer, ignore any tree
+	;; without it.
+	(and selected (not (member blob selected)))
 	;; Ignore commented sub-trees.
 	(org-element-property :commentedp blob)
 	;; Ignore archived subtrees if `:with-archived-trees' is nil.

+ 7 - 5
testing/lisp/test-org-export.el

@@ -123,14 +123,16 @@ already filled in `info'."
   ;; Test include tags.
   (org-test-with-temp-text "
 * Head1
-** Sub-Head1.1 :export:
-*** Sub-Head1.1.1
+* Head2
+** Sub-Head2.1 :export:
+*** Sub-Head2.1.1
 * Head2"
     (org-test-with-backend test
       (should
-       (string-match
-	"\\* Head1\n\\*\\* Sub-Head1.1[ \t]+:export:\n\\*\\*\\* Sub-Head1.1.1\n"
-	(org-export-as 'test nil nil nil '(:select-tags ("export")))))))
+       (equal
+	"* Head2\n** Sub-Head2.1 :export:\n*** Sub-Head2.1.1\n"
+	(let ((org-tags-column 0))
+	  (org-export-as 'test nil nil nil '(:select-tags ("export"))))))))
   ;; Test mixing include tags and exclude tags.
   (org-test-with-temp-text "
 * Head1 :export: