From a87c463818dd22cb3a92c3a08ab1369f0afd7285 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 23 Feb 2012 11:24:58 +0100 Subject: [PATCH] org-element: Move archived tree handling out of org-element-map * contrib/lisp/org-element.el: Move archived tree handling out of org-element-map. * contrib/lisp/org-export.el (org-export-get-ignore-list): Properly ignore archived with `org-export-with-archived-trees' set to `headline'. * testing/contrib/lisp/test-org-export.el (test-org-export/handle-options): Add a test for that. --- contrib/lisp/org-element.el | 16 ++-------------- contrib/lisp/org-export.el | 19 ++++++++++++++----- testing/contrib/lisp/test-org-export.el | 8 ++++++++ 3 files changed, 24 insertions(+), 19 deletions(-) diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el index c7e33b06d..f217c5f5d 100644 --- a/contrib/lisp/org-element.el +++ b/contrib/lisp/org-element.el @@ -3009,8 +3009,7 @@ information. When optional argument INFO is non-nil, it should be a plist holding export options. In that case, parts of the parse tree -not exportable according to that property list will be skipped -and files included through a keyword will be visited. +not exportable according to that property list will be skipped. When optional argument FIRST-MATCH is non-nil, stop at the first match for which FUN doesn't return nil, and return that value. @@ -3077,18 +3076,7 @@ Nil values returned from FUN are ignored in the result." ;; possible and allowed. (cond ;; Element or object not exportable. - ((member --blob (plist-get info :ignore-list))) - ;; Archived headline: Maybe apply FUN on it, but - ;; ignore contents. - ((and info - (eq --type 'headline) - (eq (plist-get info :with-archived-trees) 'headline) - (org-element-property :archivedp --blob)) - (funcall --check-blob - --type types fun - ;; Ensure --BLOB has no contents. - (list --type (nth 1 --blob)) - info)) + ((and info (member --blob (plist-get info :ignore-list)))) ;; Limiting recursion to greater elements, and --BLOB ;; isn't one. ((and (eq --category 'greater-elements) diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el index 16c08aff5..a4b8943a1 100644 --- a/contrib/lisp/org-export.el +++ b/contrib/lisp/org-export.el @@ -1414,12 +1414,21 @@ Return elements or objects to ignore as a list." (lambda (el) (if (org-export--skip-p el options) (push el ignore-list) (let ((type (org-element-type el))) - (when (or (eq type 'org-data) - (memq type org-element-greater-elements) - (memq type org-element-recursive-objects) - (eq type 'paragraph)) - (funcall walk-data el options))))) + (if (and (eq (plist-get info :with-archived-trees) 'headline) + (eq (org-element-type el) 'headline) + (org-element-property :archivedp el)) + ;; If headline is archived but tree below has + ;; to be skipped, add it to ignore list. + (mapc (lambda (e) (push e ignore-list)) + (org-element-contents el)) + ;; Move into recursive objects/elements. + (when (or (eq type 'org-data) + (memq type org-element-greater-elements) + (memq type org-element-recursive-objects) + (eq type 'paragraph)) + (funcall walk-data el options)))))) (org-element-contents data)))))) + ;; Main call. (funcall walk-data data options) ;; Return value. ignore-list)) diff --git a/testing/contrib/lisp/test-org-export.el b/testing/contrib/lisp/test-org-export.el index 84178ae68..ba9a292e0 100644 --- a/testing/contrib/lisp/test-org-export.el +++ b/testing/contrib/lisp/test-org-export.el @@ -159,6 +159,14 @@ as Org syntax." (should (equal (org-export-as 'test nil nil nil '(:with-archived-trees nil)) ""))))) + (org-test-with-temp-text "* Head1 :archive:\nbody\n** Sub-head 2" + (let ((org-archive-tag "archive")) + (org-test-with-backend "test" + (should + (string-match + "\\* Head1[ \t]+:archive:" + (org-export-as 'test nil nil nil + '(:with-archived-trees headline))))))) (org-test-with-temp-text "* Head1 :archive:" (let ((org-archive-tag "archive")) (org-test-with-backend "test" -- 2.11.4.GIT