emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals-release/org 32b64607ad: org-element-cache-map: Fix when


From: ELPA Syncer
Subject: [elpa] externals-release/org 32b64607ad: org-element-cache-map: Fix when inside indirect buffer
Date: Tue, 31 Jan 2023 16:57:59 -0500 (EST)

branch: externals-release/org
commit 32b64607ad1ebf2c044d986c2691f17c07da1ade
Author: Ihor Radchenko <yantar92@posteo.net>
Commit: Ihor Radchenko <yantar92@posteo.net>

    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 <hanno@hoowl.se>
    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 ab28811cee..4f4eebfcc2 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 09801b5d3f..1b87b224e8 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 "<point>* 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."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]