summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien <bzg@gnu.org>2020-09-07 06:49:12 +0200
committerBastien <bzg@gnu.org>2020-09-07 06:51:06 +0200
commit9f0af69dd2b03f01e6ac0c16d4feb711f7852ba0 (patch)
treef491b3b3daa204d70e4add1c7b1fa5da93eead4b
parent4df12ea39199ae46bef91649b942fadaba822075 (diff)
downloadorg-mode-9f0af69dd2b03f01e6ac0c16d4feb711f7852ba0.tar.gz
Skip archived headings when tangling and exporting
* lisp/org.el (org-in-archived-heading-p): New function. * lisp/ob-exp.el (org-babel-exp-process-buffer): * lisp/ob-tangle.el (org-babel-tangle-collect-blocks): Use `org-in-archived-heading-p' to skip archived headings when tangling and exporting. * testing/lisp/test-org.el (test-org/in-archived-heading-p): Add test for `org-in-archived-heading-p'. Reported-by: flare <gabrielxaviersmith@gmail.com> See https://orgmode.org/list/877dt9ey2c.fsf@gmail.com/
-rw-r--r--lisp/ob-exp.el4
-rw-r--r--lisp/ob-tangle.el4
-rw-r--r--lisp/org.el14
-rw-r--r--testing/lisp/test-org.el18
4 files changed, 38 insertions, 2 deletions
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index 34caf95..1830730 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -33,6 +33,7 @@
(declare-function org-escape-code-in-string "org-src" (s))
(declare-function org-export-copy-buffer "ox" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
(defvar org-src-preserve-indentation)
@@ -157,7 +158,8 @@ this template."
;; encountered.
(goto-char (point-min))
(while (re-search-forward regexp nil t)
- (unless (save-match-data (org-in-commented-heading-p))
+ (unless (save-match-data (or (org-in-commented-heading-p)
+ (org-in-archived-heading-p)))
(let* ((object? (match-end 1))
(element (save-match-data
(if object? (org-element-context)
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index b50d42d..b74b3fa 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -41,6 +41,7 @@
(declare-function org-element-type "org-element" (element))
(declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-in-archived-heading-p "org" (&optional no-inheritance))
(declare-function outline-previous-heading "outline" ())
(defcustom org-babel-tangle-lang-exts
@@ -382,7 +383,8 @@ code blocks by target file."
(if (eq last-heading-pos current-heading-pos) (cl-incf counter)
(setq counter 1)
(setq last-heading-pos current-heading-pos)))
- (unless (org-in-commented-heading-p)
+ (unless (or (org-in-commented-heading-p)
+ (org-in-archived-heading-p))
(let* ((info (org-babel-get-src-block-info 'light))
(src-lang (nth 0 info))
(src-tfile (cdr (assq :tangle (nth 2 info)))))
diff --git a/lisp/org.el b/lisp/org.el
index 280c8b3..a5c7dcf 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -20265,6 +20265,20 @@ unless optional argument NO-INHERITANCE is non-nil."
(t
(save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
+(defun org-in-archived-heading-p (&optional no-inheritance)
+ "Non-nil if point is under an archived heading.
+This function also checks ancestors of the current headline,
+unless optional argument NO-INHERITANCE is non-nil."
+ (cond
+ ((org-before-first-heading-p) nil)
+ ((let ((tags (nth 5 (org-heading-components))))
+ (and tags
+ (let ((case-fold-search nil))
+ (string-match-p org-archive-tag tags)))))
+ (no-inheritance nil)
+ (t
+ (save-excursion (and (org-up-heading-safe) (org-in-archived-heading-p))))))
+
(defun org-at-comment-p nil
"Return t if cursor is in a commented line."
(save-excursion
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 6144a7a..1d48bae 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -2087,6 +2087,24 @@
(goto-char (point-max))
(org-in-commented-heading-p t))))
+(ert-deftest test-org/in-archived-heading-p ()
+ "Test `org-in-archived-heading-p' specifications."
+ ;; Archived headline.
+ (should
+ (org-test-with-temp-text "* Headline :ARCHIVE:\nBody"
+ (goto-char (point-max))
+ (org-in-archived-heading-p)))
+ ;; Archived ancestor.
+ (should
+ (org-test-with-temp-text "* Headline :ARCHIVE:\n** Level 2\nBody"
+ (goto-char (point-max))
+ (org-in-archived-heading-p)))
+ ;; Optional argument.
+ (should-not
+ (org-test-with-temp-text "* Headline :ARCHIVE:\n** Level 2\nBody"
+ (goto-char (point-max))
+ (org-in-archived-heading-p t))))
+
(ert-deftest test-org/entry-blocked-p ()
;; Check other dependencies.
(should