branch: externals/org
commit 8fd3f4668981ee1012a82c1be2ea91dd3531978f
Author: Daniel M German <[email protected]>
Commit: Ihor Radchenko <[email protected]>
org.el: Make `org-map-region' properly set point at first heading
* lisp/org.el (org-map-region): Add a call to `goto-char' to go
to the beginning of the match after the first search.
* testing/lisp/test-org.el (test-org/map-region): Add tests
for `org-map-region'.
The current logic of `org-map-region' uses two searches.
In the first, the point is left after the asterisks of the heading.
In the subsequent calls, the point is correctly set to the first
asterisk of the headline.
This change makes sure the first header is processed the same way
as the rest.
TINYCHANGE
---
lisp/org.el | 5 +++-
testing/lisp/test-org.el | 77 ++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 81 insertions(+), 1 deletion(-)
diff --git a/lisp/org.el b/lisp/org.el
index 9ea1ca0e96..95fd46b4a5 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -7079,13 +7079,16 @@ After top level, it switches back to sibling level."
(funcall fun)))))
(defun org-map-region (fun beg end)
- "Call FUN for every heading between BEG and END."
+ "Call FUN for every heading between BEG and END.
+The point is placed at the beginning of each heading
+(including any *) before FUN is called."
(let ((org-ignore-region t))
(save-excursion
(setq end (copy-marker end))
(goto-char beg)
(when (and (re-search-forward org-outline-regexp-bol nil t)
(< (point) end))
+ (goto-char (match-beginning 0))
(funcall fun))
(while (and (progn
(outline-next-heading)
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 5cf68d3400..aa217272b5 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -3161,6 +3161,83 @@ Let’s stop here
(should (equal '("two")
(org-element-cache-map (lambda (el) (org-element-property
:title el)) :next-re "TODO"))))))
+(ert-deftest test-org/map-region ()
+ "Test `org-map-region'."
+
+ (cl-flet
+ ;; return the text from point to the end of line
+ ((extract-text-to-end-of-line ()
+ (buffer-substring-no-properties (point) (line-end-position)))
+ ;; `org-map-region' does not return anything so we need to
+ ;; wrap it in a function that saves the return value
+ ;; of the function applied to each header, and returns
+ ;; the results of applying such function as a list
+ (org-map-region-with-results (fn &optional beg end)
+ (let (results)
+ (org-map-region
+ (lambda ()
+ (let ((result (funcall fn)))
+ (push result results)))
+ (or beg (point-min))
+ (or end (point-max)))
+ (nreverse results))))
+ ;; each test returns the line of the entry
+ (dolist (org-element-use-cache '(t nil))
+ (should
+ (equal (list "* Level 1" "** Level 2")
+ (org-test-with-temp-text "* Level 1\n** Level 2"
+ (org-map-region-with-results
#'extract-text-to-end-of-line))))
+ (should
+ ;; add some text before first heading
+ (equal (list "* Level 1" "** Level 2")
+ (org-test-with-temp-text "#+filetags: :Todo:weekly:\n\n\n\n*
Level 1\n** Level 2"
+ (org-map-region-with-results
#'extract-text-to-end-of-line))))
+ (should
+ ;; do not start from the beginning of the entry, thus skip it
+ (equal (list "** Level 2" "** Another Level 2")
+ (org-test-with-temp-text "* Level 1\n** Level 2\n** Another Level
2"
+ (org-map-region-with-results
#'extract-text-to-end-of-line 5))))
+ (should
+ ;; test skipping BEG END parameters
+ (equal (list "* 345" "** 012")
+ (org-test-with-temp-text "* 345\n** 012\n 2\n** Another Level 2"
+ (org-map-region-with-results
#'extract-text-to-end-of-line 1 11))))
+ (should
+ ;; between levels (after *, but before text), should be empty
+ (equal (list )
+ (org-test-with-temp-text "* 345\n** 012\n \n** Another Level 2"
+ (org-map-region-with-results
#'extract-text-to-end-of-line 2 10))))
+ (should
+ ;; test miminal region BEG END that will process an entry
+ ;; the minimal region that can be processed begins at the line and
contains one character after
+ ;; the asterisk
+ ;; note that the callback sees all the text
+ (equal (list "* 4567890")
+ (org-test-with-temp-text "\n* 4567890\nThis is a level \n*
Another Level\n\nsome text"
+ (org-map-region-with-results
#'extract-text-to-end-of-line 2 5))))
+ (should
+ ;; a more complex test
+ (equal (list "* Level 1" "** Level 2" "* Level 1 again" "** Level 2
again")
+ (org-test-with-temp-text "
+:PROPERTIES:
+:ID: some-id
+:END:
+* Level 1
+
+Some text
+
+** Level 2
+
+More text
+
+* Level 1 again
+
+** Level 2 again
+
+"
+ (org-map-region-with-results
#'extract-text-to-end-of-line))))
+ )))
+
(ert-deftest test-org/edit-headline ()
"Test `org-edit-headline' specifications."
(should
