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/
This commit is contained in:
parent
4df12ea391
commit
9f0af69dd2
|
@ -33,6 +33,7 @@
|
||||||
(declare-function org-escape-code-in-string "org-src" (s))
|
(declare-function org-escape-code-in-string "org-src" (s))
|
||||||
(declare-function org-export-copy-buffer "ox" ())
|
(declare-function org-export-copy-buffer "ox" ())
|
||||||
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
|
(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)
|
(defvar org-src-preserve-indentation)
|
||||||
|
|
||||||
|
@ -157,7 +158,8 @@ this template."
|
||||||
;; encountered.
|
;; encountered.
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(while (re-search-forward regexp nil t)
|
(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))
|
(let* ((object? (match-end 1))
|
||||||
(element (save-match-data
|
(element (save-match-data
|
||||||
(if object? (org-element-context)
|
(if object? (org-element-context)
|
||||||
|
|
|
@ -41,6 +41,7 @@
|
||||||
(declare-function org-element-type "org-element" (element))
|
(declare-function org-element-type "org-element" (element))
|
||||||
(declare-function org-heading-components "org" ())
|
(declare-function org-heading-components "org" ())
|
||||||
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
|
(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" ())
|
(declare-function outline-previous-heading "outline" ())
|
||||||
|
|
||||||
(defcustom org-babel-tangle-lang-exts
|
(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)
|
(if (eq last-heading-pos current-heading-pos) (cl-incf counter)
|
||||||
(setq counter 1)
|
(setq counter 1)
|
||||||
(setq last-heading-pos current-heading-pos)))
|
(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))
|
(let* ((info (org-babel-get-src-block-info 'light))
|
||||||
(src-lang (nth 0 info))
|
(src-lang (nth 0 info))
|
||||||
(src-tfile (cdr (assq :tangle (nth 2 info)))))
|
(src-tfile (cdr (assq :tangle (nth 2 info)))))
|
||||||
|
|
14
lisp/org.el
14
lisp/org.el
|
@ -20265,6 +20265,20 @@ unless optional argument NO-INHERITANCE is non-nil."
|
||||||
(t
|
(t
|
||||||
(save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
|
(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
|
(defun org-at-comment-p nil
|
||||||
"Return t if cursor is in a commented line."
|
"Return t if cursor is in a commented line."
|
||||||
(save-excursion
|
(save-excursion
|
||||||
|
|
|
@ -2087,6 +2087,24 @@
|
||||||
(goto-char (point-max))
|
(goto-char (point-max))
|
||||||
(org-in-commented-heading-p t))))
|
(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 ()
|
(ert-deftest test-org/entry-blocked-p ()
|
||||||
;; Check other dependencies.
|
;; Check other dependencies.
|
||||||
(should
|
(should
|
||||||
|
|
Loading…
Reference in New Issue