Rename `org-babel-under-commented-heading-p'

* lisp/org.el (org-in-commented-heading-p): New function.
* lisp/ob-tangle.el (org-babel-under-commented-heading-p): Remove
  function.
(org-babel-tangle-collect-blocks): Use new function.
* lisp/ob-exp.el (org-babel-exp-process-buffer): Use new function.

* testing/lisp/test-org.el (test-org/in-commented-heading-p): New
  test.
This commit is contained in:
Nicolas Goaziou 2014-03-24 16:12:12 +01:00 committed by Eric Schulte
parent 230d09aeb0
commit 6d1d61f667
4 changed files with 50 additions and 18 deletions

View File

@ -158,7 +158,7 @@ may make them unreachable."
"^[ \t]*#\\+BEGIN_SRC")))
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(unless (save-match-data (org-babel-under-commented-heading-p))
(unless (save-match-data (org-in-commented-heading-p))
(let* ((element (save-excursion
;; If match is inline, point is at its
;; end. Move backward so

View File

@ -357,22 +357,6 @@ that the appropriate major-mode is set. SPEC has the form:
insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data)))))
(defvar org-comment-string) ;; Defined in org.el
(defun org-babel-under-commented-heading-p ()
"Non-nil if point is under a commented heading.
This function also checks ancestors of the current headline, if
any."
(cond
((org-before-first-heading-p) nil)
((let ((headline (nth 4 (org-heading-components))))
(and headline
(let ((case-fold-search nil))
(org-string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
headline)))))
(t (save-excursion
(and (org-up-heading-safe)
(org-babel-under-commented-heading-p))))))
(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
"Collect source blocks in the current Org-mode file.
Return an association list of source-code block specifications of
@ -396,7 +380,7 @@ can be used to limit the collected code blocks by target file."
(let* ((info (org-babel-get-src-block-info 'light))
(src-lang (nth 0 info))
(src-tfile (cdr (assoc :tangle (nth 2 info)))))
(unless (or (org-babel-under-commented-heading-p)
(unless (or (org-in-commented-heading-p)
(string= (cdr (assoc :tangle (nth 2 info))) "no")
(and tangle-file (not (equal tangle-file src-tfile))))
(unless (and language (not (string= language src-lang)))

View File

@ -23303,6 +23303,22 @@ This version does not only check the character property, but also
;; Compatibility alias with Org versions < 7.8.03
(defalias 'org-on-heading-p 'org-at-heading-p)
(defun org-in-commented-heading-p (&optional no-inheritance)
"Non-nil if point is under a commented 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 ((headline (nth 4 (org-heading-components))))
(and headline
(let ((case-fold-search nil))
(org-string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
headline)))))
(no-inheritance nil)
(t (save-excursion
(and (org-up-heading-safe)
(org-in-commented-heading-p t))))))
(defun org-at-comment-p nil
"Is cursor in a line starting with a # character?"
(save-excursion

View File

@ -543,6 +543,38 @@
(buffer-string)))))
;;; Headline
(ert-deftest test-org/in-commented-heading-p ()
"Test `org-in-commented-heading-p' specifications."
;; Commented headline.
(should
(org-test-with-temp-text "* COMMENT Headline\nBody"
(goto-char (point-max))
(org-in-commented-heading-p)))
;; Commented ancestor.
(should
(org-test-with-temp-text "* COMMENT Headline\n** Level 2\nBody"
(goto-char (point-max))
(org-in-commented-heading-p)))
;; Comment keyword is case-sensitive.
(should-not
(org-test-with-temp-text "* Comment Headline\nBody"
(goto-char (point-max))
(org-in-commented-heading-p)))
;; Keyword is standalone.
(should-not
(org-test-with-temp-text "* COMMENTHeadline\nBody"
(goto-char (point-max))
(org-in-commented-heading-p)))
;; Optional argument.
(should-not
(org-test-with-temp-text "* COMMENT Headline\n** Level 2\nBody"
(goto-char (point-max))
(org-in-commented-heading-p t))))
;;; Links