From 32b64607ad1ebf2c044d986c2691f17c07da1ade Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Wed, 1 Feb 2023 00:18:56 +0300 Subject: [PATCH] org-element-cache-map: Fix when inside indirect buffer * lisp/org-element.el: Query cache variables from the base buffer. They are only kept up-to-date there. * testing/lisp/test-org.el (test-org/map-entries): Add test. Reported-by: Hanno Perrey Link: https://orgmode.org/list/87pmau4fi3.fsf@hoowl.se --- lisp/org-element.el | 35 +++++++++++++++++++++-------------- testing/lisp/test-org.el | 16 +++++++++++++++- 2 files changed, 36 insertions(+), 15 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index ab28811ce..4f4eebfcc 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -7406,14 +7406,16 @@ the cache." (org-element-at-point to-pos) (cl-macrolet ((cache-root ;; Use the most optimal version of cache available. - () `(if (memq granularity '(headline headline+inlinetask)) - (org-element--headline-cache-root) - (org-element--cache-root))) + () `(org-with-base-buffer nil + (if (memq granularity '(headline headline+inlinetask)) + (org-element--headline-cache-root) + (org-element--cache-root)))) (cache-size ;; Use the most optimal version of cache available. - () `(if (memq granularity '(headline headline+inlinetask)) - org-element--headline-cache-size - org-element--cache-size)) + () `(org-with-base-buffer nil + (if (memq granularity '(headline headline+inlinetask)) + org-element--headline-cache-size + org-element--cache-size))) (cache-walk-restart ;; Restart tree traversal after AVL tree re-balance. () `(when node @@ -7443,8 +7445,9 @@ the cache." ;; Avoid extra staff like timer cancels et al ;; and only call `org-element--cache-sync-requests' when ;; there are pending requests. - (when org-element--cache-sync-requests - (org-element--cache-sync (current-buffer))) + (org-with-base-buffer nil + (when org-element--cache-sync-requests + (org-element--cache-sync (current-buffer)))) ;; Call `org-element--parse-to' directly avoiding any ;; kind of `org-element-at-point' overheads. (if restrict-elements @@ -7515,8 +7518,9 @@ the cache." tmpnext-start)) ;; Check if cache does not have gaps. (cache-gapless-p - () `(eq org-element--cache-change-tic - (alist-get granularity org-element--cache-gapless)))) + () `(org-with-base-buffer nil + (eq org-element--cache-change-tic + (alist-get granularity org-element--cache-gapless))))) ;; The core algorithm is simple walk along binary tree. However, ;; instead of checking all the tree elements from first to last ;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping @@ -7644,7 +7648,9 @@ the cache." ;; In the process, we may alter the buffer, ;; so also keep track of the cache state. (progn - (setq modified-tic org-element--cache-change-tic) + (setq modified-tic + (org-with-base-buffer nil + org-element--cache-change-tic)) (setq cache-size (cache-size)) ;; When NEXT-RE/FAIL-RE is provided, skip to ;; next regexp match after :begin of the current @@ -7678,7 +7684,7 @@ the cache." ;; ;; Call FUNC. FUNC may move point. (setq org-element-cache-map-continue-from nil) - (if org-element--cache-map-statistics + (if (org-with-base-buffer nil org-element--cache-map-statistics) (progn (setq before-time (float-time)) (push (funcall func data) result) @@ -7718,8 +7724,9 @@ the cache." start)) (setq start nil)) ;; Check if the buffer has been modified. - (unless (and (eq modified-tic org-element--cache-change-tic) - (eq cache-size (cache-size))) + (unless (org-with-base-buffer nil + (and (eq modified-tic org-element--cache-change-tic) + (eq cache-size (cache-size)))) ;; START may no longer be valid, update ;; it to beginning of real element. ;; Upon modification, START may lay diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 09801b5d3..1b87b224e 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -2741,6 +2741,7 @@ SCHEDULED: <2014-03-04 tue.>" (org-element-property :begin (org-element-at-point)))))) (buffer-string)))) + ;; Move point. (should (= 1 (org-test-with-temp-text "* H1\n** H1.1\n** H1.2\n" @@ -2760,7 +2761,20 @@ SCHEDULED: <2014-03-04 tue.>" (push (org-element-property :title (org-element-at-point)) acc) (setq org-map-continue-from (line-end-position 2)))) - (length acc)))))) + (length acc))))) + ;; Modifications inside indirect buffer. + (should + (= 3 + (org-test-with-temp-text "* H1\n** H1.1\n** H1.2\n" + (with-current-buffer (org-get-indirect-buffer) + (let ((acc 0)) + (org-map-entries + (lambda () + (cl-incf acc) + (beginning-of-line 2) + (insert "test\n") + (beginning-of-line -1))) + acc)))))) (ert-deftest test-org/edit-headline () "Test `org-edit-headline' specifications."