Przeglądaj źródła

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
Ihor Radchenko 3 lat temu
rodzic
commit
4426d8009f
1 zmienionych plików z 73 dodań i 38 usunięć
  1. 73 38
      lisp/org-element.el

+ 73 - 38
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)))