org-element-cache-map: Fix when FUNC deletes current element

* lisp/org-element.el (org-element-cache-map-continue-from): New
variable forcing `org-element-cache-map' to continue from a custom
point in buffer.
(org-element-cache-map): Add support for
`org-element-cache-map-continue-from'.  Update docstring accordingly.
Also, make sure that mapping terminates correctly when FUNC deletes
all elements in buffer.
* testing/lisp/test-org.el (test-org/map-entries): Add test.

Fixes https://orgmode.org/list/CADywB5KOJ1p0NpvA=iX-ybHsO=huGA8qL3xMpUTETmS2qp7_ng@mail.gmail.com
This commit is contained in:
Ihor Radchenko 2022-01-01 14:10:28 +08:00
parent ce75d2b8b9
commit 06f58e4759
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
3 changed files with 34 additions and 8 deletions

View File

@ -7118,6 +7118,10 @@ buffers."
(defvar warning-minimum-log-level) ; Defined in warning.el (defvar warning-minimum-log-level) ; Defined in warning.el
(defvar org-element-cache-map--recurse nil) (defvar org-element-cache-map--recurse nil)
(defvar org-element-cache-map-continue-from nil
"Position from where mapping should continue.
This variable can be set by called function, especially when the
function modified the buffer.")
;;;###autoload ;;;###autoload
(cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) restrict-elements (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) restrict-elements
next-re fail-re from-pos (to-pos (point-max-marker)) after-element limit-count next-re fail-re from-pos (to-pos (point-max-marker)) after-element limit-count
@ -7127,8 +7131,14 @@ GRANULARITY. Collect non-nil return values into result list.
FUNC should accept a single argument - the element. FUNC should accept a single argument - the element.
FUNC can safely modify the buffer, but doing so may reduce FUNC can modify the buffer, but doing so may reduce performance. If
performance. buffer is modified, the mapping will continue from an element starting
after the last mapped element. If the last mapped element is deleted,
the subsequent element will be skipped as it cannot be distinguished
deterministically from a changed element. If FUNC is expected to
delete the element, it should directly set the value of
`org-element-cache-map-continue-from' to force `org-element-cache-map'
continue from the right point in buffer.
If some elements are not yet in cache, they will be added. If some elements are not yet in cache, they will be added.
@ -7264,7 +7274,7 @@ the cache."
(setq start (match-beginning 0)) (setq start (match-beginning 0))
(setq start (max (or start -1) (setq start (max (or start -1)
(or (org-element-property :begin data) -1) (or (org-element-property :begin data) -1)
(org-element-property :begin (element-match-at-point))))) (or (org-element-property :begin (element-match-at-point)) -1))))
(when (>= start to-pos) (cache-walk-abort))) (when (>= start to-pos) (cache-walk-abort)))
(cache-walk-abort)))) (cache-walk-abort))))
;; Find expected begin position of an element after ;; Find expected begin position of an element after
@ -7507,6 +7517,7 @@ the cache."
;; DATA matches restriction. FUNC may ;; DATA matches restriction. FUNC may
;; ;;
;; Call FUNC. FUNC may move point. ;; Call FUNC. FUNC may move point.
(setq org-element-cache-map-continue-from nil)
(if org-element--cache-map-statistics (if org-element--cache-map-statistics
(progn (progn
(setq before-time (float-time)) (setq before-time (float-time))
@ -7523,6 +7534,8 @@ the cache."
(setq last-match (car result)) (setq last-match (car result))
;; If FUNC moved point forward, update ;; If FUNC moved point forward, update
;; START. ;; START.
(when org-element-cache-map-continue-from
(goto-char org-element-cache-map-continue-from))
(when (> (point) start) (when (> (point) start)
(move-start-to-next-match nil)) (move-start-to-next-match nil))
;; Drop nil. ;; Drop nil.
@ -7541,7 +7554,6 @@ the cache."
(eq cache-size (cache-size))) (eq cache-size (cache-size)))
;; START may no longer be valid, update ;; START may no longer be valid, update
;; it to beginning of real element. ;; it to beginning of real element.
(when start (goto-char start))
;; Upon modification, START may lay ;; Upon modification, START may lay
;; inside an element. We want to move ;; inside an element. We want to move
;; it to real beginning then despite ;; it to real beginning then despite
@ -7553,11 +7565,15 @@ the cache."
;; Make sure that we continue from an ;; Make sure that we continue from an
;; element past already processed ;; element past already processed
;; place. ;; place.
(when (<= start (org-element-property :begin data)) (when (and (<= start (org-element-property :begin data))
(not org-element-cache-map-continue-from))
(goto-char start) (goto-char start)
(setq data (element-match-at-point)) (setq data (element-match-at-point))
(goto-char (next-element-start)) ;; If DATA is nil, buffer is
(move-start-to-next-match next-element-re)) ;; empty. Abort.
(when data
(goto-char (next-element-start))
(move-start-to-next-match next-element-re)))
(org-element-at-point to-pos) (org-element-at-point to-pos)
(cache-walk-restart)) (cache-walk-restart))
;; Reached LIMIT-COUNT. Abort. ;; Reached LIMIT-COUNT. Abort.

View File

@ -11641,6 +11641,7 @@ headlines matching this string."
(goto-char (1- (org-element-property :end el)))))) (goto-char (1- (org-element-property :end el))))))
;; Get the correct position from where to continue ;; Get the correct position from where to continue
(when org-map-continue-from (when org-map-continue-from
(setq org-element-cache-map-continue-from org-map-continue-from)
(goto-char org-map-continue-from)) (goto-char org-map-continue-from))
;; Return nil. ;; Return nil.
nil) nil)

View File

@ -2405,7 +2405,16 @@ SCHEDULED: <2014-03-04 tue.>"
(equal '(22) (equal '(22)
(org-test-with-temp-text "* H1 :yes:\n* H2 :no:\n* H3 :yes:no:" (org-test-with-temp-text "* H1 :yes:\n* H2 :no:\n* H3 :yes:no:"
(let (org-odd-levels-only) (let (org-odd-levels-only)
(org-map-entries #'point "yes&no")))))) (org-map-entries #'point "yes&no")))))
;; Setting `org-map-continue-from'
(should
(string= ""
(org-test-with-temp-text "* H1\n* H2\n* H3n* H4"
(org-map-entries
(lambda ()
(org-cut-subtree)
(setq org-map-continue-from (point))))
(buffer-string)))))
(ert-deftest test-org/edit-headline () (ert-deftest test-org/edit-headline ()
"Test `org-edit-headline' specifications." "Test `org-edit-headline' specifications."