diff options
author | Bastien <bzg@gnu.org> | 2020-09-07 06:49:12 +0200 |
---|---|---|
committer | Bastien <bzg@gnu.org> | 2020-09-07 06:51:06 +0200 |
commit | 9f0af69dd2b03f01e6ac0c16d4feb711f7852ba0 (patch) | |
tree | f491b3b3daa204d70e4add1c7b1fa5da93eead4b | |
parent | 4df12ea39199ae46bef91649b942fadaba822075 (diff) | |
download | org-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.el | 4 | ||||
-rw-r--r-- | lisp/ob-tangle.el | 4 | ||||
-rw-r--r-- | lisp/org.el | 14 | ||||
-rw-r--r-- | testing/lisp/test-org.el | 18 |
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 |