[elpa] externals/org 4426d80 3/3: org-element-cache: Fix Phase 1 when new parent overlaps future edits

[ELPA Syncer]

branch: externals/org
commit 4426d8009f14bcb48e91ce5517af3af4f762ab22
Author: Ihor Radchenko <yantar92@gmail.com>
Commit: Ihor Radchenko <yantar92@gmail.com>

    org-element-cache: Fix Phase 1 when new parent overlaps future edits
    
    * lisp/org-element.el (org-element--cache-process-request): New OFFSET
    argument used to correct newly added parents during Phase 1.  The
    `org-element--parse-to' call inside Phase 1 may add new elements to
    cache that intersect with future edits.  Boundaries of these elements
    may be shifted twice, so we have to offset the future shift.
    
    (org-element--cache-sync): New OFFSET argument providing future change
    info to `org-element--cache-process-request'.
    
    (org-element--cache-submit-request): Provide offset value in
    `org-elemnt--cache-sync' call.
    
    (org-element--cache-submit-request):
    (org-element--cache-process-request):
    (org-element--cache-sync): Never use %d format for region boundaries.
    It may be a marker and cause error.  Use %S instead.
    
    (org-element--cache-process-request): Use unique symbols for
    catch-throw.
    
    Fixes 
https://list.orgmode.org/CAFyQvY3Qv5xn-ET83L6Rzg-V1zOVu4y1gt+-_CpfaWNAdt87xA@mail.gmail.com/T/#t
---
 lisp/org-element.el | 111 ++++++++++++++++++++++++++++++++++------------------
 1 file changed, 73 insertions(+), 38 deletions(-)

diff --git a/lisp/org-element.el b/lisp/org-element.el
index 112e335..a617c58 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -5840,7 +5840,7 @@ It is a symbol among nil, t, or a number representing 
smallest level of
 modified headline.  The level considers headline levels both before
 and after the modification.")
 
-(defun org-element--cache-sync (buffer &optional threshold future-change)
+(defun org-element--cache-sync (buffer &optional threshold future-change 
offset)
   "Synchronize cache with recent modification in BUFFER.
 
 When optional argument THRESHOLD is non-nil, do the
@@ -5850,9 +5850,10 @@ then exit.  Otherwise, synchronize cache for as long as
 state.
 
 FUTURE-CHANGE, when non-nil, is a buffer position where changes
-not registered yet in the cache are going to happen.  It is used
-in `org-element--cache-submit-request', where cache is partially
-updated before current modification are actually submitted."
+not registered yet in the cache are going to happen.  OFFSET is the
+change offset.  It is used in `org-element--cache-submit-request',
+where cache is partially updated before current modification are
+actually submitted."
   (when (buffer-live-p buffer)
     (with-current-buffer (or (buffer-base-buffer buffer) buffer)
       ;; Check if the buffer have been changed outside visibility of
@@ -5911,7 +5912,8 @@ The buffer is: %s\n Current command: %S\n Chars modified: 
%S\n Buffer modified:
                 (when next (org-element--request-key next))
                 threshold
                 (unless threshold time-limit)
-                future-change)
+                future-change
+                 offset)
                 ;; Re-assign current and next requests.  It could have
                 ;; been altered during phase 1.
                 (setq request (car org-element--cache-sync-requests)
@@ -5923,7 +5925,7 @@ The buffer is: %s\n Current command: %S\n Chars modified: 
%S\n Buffer modified:
                   ;; or phase 2 requests.  We need to let them know
                   ;; that additional shifting happened ahead of them.
                  (cl-incf (org-element--request-offset next) 
(org-element--request-offset request))
-                  (org-element--cache-log-message "Updating next request 
offset to %d: %s"
+                  (org-element--cache-log-message "Updating next request 
offset to %S: %s"
                                        (org-element--request-offset next)
                                        (let ((print-length 10) (print-level 
3)) (prin1-to-string next)))
                   ;; FIXME: END part of the request only matters for
@@ -5942,7 +5944,7 @@ The buffer is: %s\n Current command: %S\n Chars modified: 
%S\n Buffer modified:
             (setq org-element--cache-sync-keys-value (1+ 
org-element--cache-sync-keys-value))))))))
 
 (defun org-element--cache-process-request
-    (request next-request-key threshold time-limit future-change)
+    (request next-request-key threshold time-limit future-change offset)
   "Process synchronization REQUEST for all entries before NEXT.
 
 REQUEST is a vector, built by `org-element--cache-submit-request'.
@@ -5956,9 +5958,10 @@ stops as soon as a shifted element begins after it.
 When non-nil, TIME-LIMIT is a time value.  Synchronization stops
 after this time or when Emacs exits idle state.
 
-When non-nil, FUTURE-CHANGE is a buffer position where changes
-not registered yet in the cache are going to happen.  See
-`org-element--cache-submit-request' for more information.
+When non-nil, FUTURE-CHANGE is a buffer position where changes not
+registered yet in the cache are going to happen.  OFFSET is the
+changed text length.  See `org-element--cache-submit-request' for more
+information.
 
 Throw `org-element--cache-interrupt' if the process stops before
 completing the request."
@@ -5967,7 +5970,7 @@ completing the request."
                        future-change
                        threshold
                        next-request-key)
-  (catch 'quit
+  (catch 'org-element--cache-quit
     (when (= (org-element--request-phase request) 0)
       ;; Phase 0.
       ;;
@@ -5977,7 +5980,7 @@ completing the request."
       ;; At each iteration, we start again at tree root since
       ;; a deletion modifies structure of the balanced tree.
       (org-element--cache-log-message "Phase 0")
-      (catch 'end-phase
+      (catch 'org-element--cache-end-phase
         (let ((deletion-count 0))
           (while t
            (when (org-element--cache-interrupt-p time-limit)
@@ -6022,23 +6025,23 @@ completing the request."
                                                             
org-element--cache-size
                                                             (log 
org-element--cache-size 2))
                             (org-element-cache-reset)
-                            (throw 'quit t)))
+                            (throw 'org-element--cache-quit t)))
                       ;; Done deleting everthing starting before END.
                       ;; DATA-KEY is the first known element after END.
                       ;; Move on to phase 1.
-                      (org-element--cache-log-message "found element after %d: 
%S::%S"
-                                                      end
-                                                      (org-element-property 
:org-element--cache-sync-key data)
-                                                      
(org-element--format-element data))
+                      (org-element--cache-log-message "found element after %S: 
%S::%S"
+                                           end
+                                           (org-element-property 
:org-element--cache-sync-key data)
+                                           (org-element--format-element data))
                       (setf (org-element--request-key request) data-key)
                       (setf (org-element--request-beg request) pos)
                       (setf (org-element--request-phase request) 1)
-                     (throw 'end-phase nil)))
+                     (throw 'org-element--cache-end-phase nil)))
                ;; No element starting after modifications left in
                ;; cache: further processing is futile.
                 (org-element--cache-log-message "Phase 0 deleted all elements 
in cache after %S!"
-                                                request-key)
-               (throw 'quit t)))))))
+                                     request-key)
+               (throw 'org-element--cache-quit t)))))))
     (when (= (org-element--request-phase request) 1)
       ;; Phase 1.
       ;;
@@ -6087,14 +6090,15 @@ completing the request."
            (setf (org-element--request-key next-request) key)
             (setf (org-element--request-beg next-request) 
(org-element--request-beg request))
            (setf (org-element--request-phase next-request) 1)
-            (throw 'quit t))))
+            (throw 'org-element--cache-quit t))))
       ;; Next element will start at its beginning position plus
       ;; offset, since it hasn't been shifted yet.  Therefore, LIMIT
       ;; contains the real beginning position of the first element to
       ;; shift and re-parent.
-      (let ((limit (+ (org-element--request-beg request) 
(org-element--request-offset request))))
+      (let ((limit (+ (org-element--request-beg request) 
(org-element--request-offset request)))
+            cached-before)
        (cond ((and threshold (> limit threshold))
-               (org-element--cache-log-message "Interrupt: position %d after 
threshold %d" limit threshold)
+               (org-element--cache-log-message "Interrupt: position %S after 
threshold %S" limit threshold)
                (throw 'org-element--cache-interrupt nil))
              ((and future-change (>= limit future-change))
               ;; Changes happened around this element and they will
@@ -6102,18 +6106,49 @@ completing the request."
               ;; and simply proceed with shifting (phase 2) to make
               ;; sure that followup phase 0 request for the recent
               ;; changes can operate on the correctly shifted cache.
-               (org-element--cache-log-message "position %d after future 
change %d" limit future-change)
+               (org-element--cache-log-message "position %S after future 
change %S" limit future-change)
                (setf (org-element--request-parent request) nil)
                (setf (org-element--request-phase request) 2))
              (t
+               (when future-change
+                 ;; Changes happened, but not yet registered after
+                 ;; this element.  However, we a not yet safe to look
+                 ;; at the buffer and parse elements in the cache gap.
+                 ;; Some of the parents to be added to cache may end
+                 ;; after the changes.  Parsing this parents will
+                 ;; assign the :end correct value for cache state
+                 ;; after future-change.  Then, when the future change
+                 ;; is going to be processed, such parent boundary
+                 ;; will be altered unnecessarily.  To avoid this,
+                 ;; we alter the new parents by -OFFSET.
+                 ;; For now, just save last known cached element and
+                 ;; then check all the parents below.
+                 (setq cached-before (org-element--cache-find (1- limit) nil)))
                ;; No relevant changes happened after submitting this
                ;; request.  We are safe to look at the actual Org
                ;; buffer and calculate the new parent.
               (let ((parent (org-element--parse-to (1- limit) nil time-limit)))
-                 (org-element--cache-log-message "New parent at %d: %S::%S"
-                                                 limit
-                                                 (org-element-property 
:org-element--cache-sync-key parent)
-                                                 (org-element--format-element 
parent))
+                 (when future-change
+                   ;; Check all the newly added parents to not
+                   ;; intersect with future change.
+                   (let ((up parent))
+                     (while (and up
+                                 (or (not cached-before)
+                                     (> (org-element-property :begin up)
+                                        (org-element-property :begin 
cached-before))))
+                       (when (> (org-element-property :end up) future-change)
+                         ;; Offset future cache request.
+                         (org-element--cache-shift-positions
+                          up (- offset)
+                          (if (and (org-element-property :robust-begin up)
+                                   (org-element-property :robust-end up))
+                              '(:contents-end :end :robust-end)
+                            '(:contents-end :end))))
+                       (setq up (org-element-property :parent up)))))
+                 (org-element--cache-log-message "New parent at %S: %S::%S"
+                                      limit
+                                      (org-element-property 
:org-element--cache-sync-key parent)
+                                      (org-element--format-element parent))
                  (setf (org-element--request-parent request) parent)
                 (setf (org-element--request-phase request) 2))))))
     ;; Phase 2.
@@ -6138,7 +6173,7 @@ completing the request."
       ;; No re-parenting nor shifting planned: request is over.
       (when (and (not parent) (zerop offset))
         (org-element--cache-log-message "Empty offset. Request completed.")
-        (throw 'quit t))
+        (throw 'org-element--cache-quit t))
       (while node
        (let* ((data (avl-tree--node-data node))
               (key (org-element--cache-key data)))
@@ -6164,7 +6199,7 @@ completing the request."
                                (> (org-element-property :begin 
(org-element--request-parent next-request))
                                   (org-element-property :begin parent)))
                     (setf (org-element--request-parent next-request) parent)))
-                (throw 'quit t))
+                (throw 'org-element--cache-quit t))
              ;; Handle interruption request.  Update current request.
              (when (or exit-flag (org-element--cache-interrupt-p time-limit))
                 (org-element--cache-log-message "Interrupt: %s" (if exit-flag 
"threshold" "time limit"))
@@ -6185,7 +6220,7 @@ completing the request."
                (while (and parent
                            (<= (org-element-property :end parent) begin))
                  (setq parent (org-element-property :parent parent)))
-               (cond ((and (not parent) (zerop offset)) (throw 'quit nil))
+               (cond ((and (not parent) (zerop offset)) (throw 
'org-element--cache-quit nil))
                       ;; Consider scenario when DATA lays within
                       ;; sensitive lines of PARENT that was found
                       ;; during phase 2.  For example:
@@ -6245,7 +6280,7 @@ completing the request."
                          ;; else.
                          (org-element--cache-warn "Added org-data parent to 
non-headline element: %S\nIf this warning appears regularly, please report it 
to Org mode mailing list (M-x org-submit-bug-report)." data)
                          (org-element-cache-reset)
-                         (throw 'quit t))
+                         (throw 'org-element--cache-quit t))
                       (org-element-put-property data :parent parent)
                       (let ((s (org-element-property :structure parent)))
                         (when (and s (org-element-property :structure data))
@@ -6264,9 +6299,9 @@ completing the request."
                           (pop stack)))))))
       ;; We reached end of tree: synchronization complete.
       t))
-  (org-element--cache-log-message "org-element-cache: Finished process. The 
cache size is %d. The remaining sync requests: %S"
-                                  org-element--cache-size
-                                  (let ((print-level 2)) (prin1-to-string 
org-element--cache-sync-requests))))
+  (org-element--cache-log-message "org-element-cache: Finished process. The 
cache size is %S. The remaining sync requests: %S"
+                       org-element--cache-size
+                       (let ((print-level 2)) (prin1-to-string 
org-element--cache-sync-requests))))
 
 (defsubst org-element--open-end-p (element)
   "Check if ELEMENT in current buffer contains extra blank lines after
@@ -6854,7 +6889,7 @@ change, as an integer."
         ;; yet to the otherwise correct part of the cache (i.e, before
         ;; the first request).
         (org-element--cache-log-message "Adding new phase 0 request")
-        (when next (org-element--cache-sync (current-buffer) end beg))
+        (when next (org-element--cache-sync (current-buffer) end beg offset))
         (let ((first (org-element--cache-for-removal beg end offset)))
          (if first
              (push (let ((first-beg (org-element-property :begin first))
@@ -6912,13 +6947,13 @@ change, as an integer."
            ;; Simply shift additional elements, if any, by OFFSET.
            (if org-element--cache-sync-requests
                 (progn
-                  (org-element--cache-log-message "Nothing to remove. Updating 
offset of the next request by 𝝙%d: %S"
+                  (org-element--cache-log-message "Nothing to remove. Updating 
offset of the next request by 𝝙%S: %S"
                                        offset
                                        (let ((print-level 3))
                                          (car 
org-element--cache-sync-requests)))
                  (cl-incf (org-element--request-offset (car 
org-element--cache-sync-requests))
                           offset))
-              (org-element--cache-log-message "Nothing to remove. No elements 
in cache after %d. Terminating."
+              (org-element--cache-log-message "Nothing to remove. No elements 
in cache after %S. Terminating."
                                    end))))))
     (setq org-element--cache-change-warning nil)))