فهرست منبع

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 سال پیش
والد
کامیت
4426d8009f
1فایلهای تغییر یافته به همراه73 افزوده شده و 38 حذف شده
  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
 modified headline.  The level considers headline levels both before
 and after the modification.")
 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.
   "Synchronize cache with recent modification in BUFFER.
 
 
 When optional argument THRESHOLD is non-nil, do the
 When optional argument THRESHOLD is non-nil, do the
@@ -5850,9 +5850,10 @@ then exit.  Otherwise, synchronize cache for as long as
 state.
 state.
 
 
 FUTURE-CHANGE, when non-nil, is a buffer position where changes
 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)
   (when (buffer-live-p buffer)
     (with-current-buffer (or (buffer-base-buffer buffer) buffer)
     (with-current-buffer (or (buffer-base-buffer buffer) buffer)
       ;; Check if the buffer have been changed outside visibility of
       ;; 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))
 	         (when next (org-element--request-key next))
 	         threshold
 	         threshold
 	         (unless threshold time-limit)
 	         (unless threshold time-limit)
-	         future-change)
+	         future-change
+                 offset)
                 ;; Re-assign current and next requests.  It could have
                 ;; Re-assign current and next requests.  It could have
                 ;; been altered during phase 1.
                 ;; been altered during phase 1.
                 (setq request (car org-element--cache-sync-requests)
                 (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
                   ;; or phase 2 requests.  We need to let them know
                   ;; that additional shifting happened ahead of them.
                   ;; that additional shifting happened ahead of them.
 	          (cl-incf (org-element--request-offset next) (org-element--request-offset request))
 	          (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)
                                        (org-element--request-offset next)
                                        (let ((print-length 10) (print-level 3)) (prin1-to-string next)))
                                        (let ((print-length 10) (print-level 3)) (prin1-to-string next)))
                   ;; FIXME: END part of the request only matters for
                   ;; 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))))))))
             (setq org-element--cache-sync-keys-value (1+ org-element--cache-sync-keys-value))))))))
 
 
 (defun org-element--cache-process-request
 (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.
   "Process synchronization REQUEST for all entries before NEXT.
 
 
 REQUEST is a vector, built by `org-element--cache-submit-request'.
 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
 When non-nil, TIME-LIMIT is a time value.  Synchronization stops
 after this time or when Emacs exits idle state.
 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
 Throw `org-element--cache-interrupt' if the process stops before
 completing the request."
 completing the request."
@@ -5967,7 +5970,7 @@ completing the request."
                        future-change
                        future-change
                        threshold
                        threshold
                        next-request-key)
                        next-request-key)
-  (catch 'quit
+  (catch 'org-element--cache-quit
     (when (= (org-element--request-phase request) 0)
     (when (= (org-element--request-phase request) 0)
       ;; Phase 0.
       ;; Phase 0.
       ;;
       ;;
@@ -5977,7 +5980,7 @@ completing the request."
       ;; At each iteration, we start again at tree root since
       ;; At each iteration, we start again at tree root since
       ;; a deletion modifies structure of the balanced tree.
       ;; a deletion modifies structure of the balanced tree.
       (org-element--cache-log-message "Phase 0")
       (org-element--cache-log-message "Phase 0")
-      (catch 'end-phase
+      (catch 'org-element--cache-end-phase
         (let ((deletion-count 0))
         (let ((deletion-count 0))
           (while t
           (while t
 	    (when (org-element--cache-interrupt-p time-limit)
 	    (when (org-element--cache-interrupt-p time-limit)
@@ -6022,23 +6025,23 @@ completing the request."
                                                             org-element--cache-size
                                                             org-element--cache-size
                                                             (log org-element--cache-size 2))
                                                             (log org-element--cache-size 2))
                             (org-element-cache-reset)
                             (org-element-cache-reset)
-                            (throw 'quit t)))
+                            (throw 'org-element--cache-quit t)))
                       ;; Done deleting everthing starting before END.
                       ;; Done deleting everthing starting before END.
                       ;; DATA-KEY is the first known element after END.
                       ;; DATA-KEY is the first known element after END.
                       ;; Move on to phase 1.
                       ;; 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-key request) data-key)
                       (setf (org-element--request-beg request) pos)
                       (setf (org-element--request-beg request) pos)
                       (setf (org-element--request-phase request) 1)
                       (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
 	        ;; No element starting after modifications left in
 	        ;; cache: further processing is futile.
 	        ;; cache: further processing is futile.
                 (org-element--cache-log-message "Phase 0 deleted all elements in cache after %S!"
                 (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)
     (when (= (org-element--request-phase request) 1)
       ;; Phase 1.
       ;; Phase 1.
       ;;
       ;;
@@ -6087,14 +6090,15 @@ completing the request."
 	    (setf (org-element--request-key next-request) key)
 	    (setf (org-element--request-key next-request) key)
             (setf (org-element--request-beg next-request) (org-element--request-beg request))
             (setf (org-element--request-beg next-request) (org-element--request-beg request))
 	    (setf (org-element--request-phase next-request) 1)
 	    (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
       ;; Next element will start at its beginning position plus
       ;; offset, since it hasn't been shifted yet.  Therefore, LIMIT
       ;; offset, since it hasn't been shifted yet.  Therefore, LIMIT
       ;; contains the real beginning position of the first element to
       ;; contains the real beginning position of the first element to
       ;; shift and re-parent.
       ;; 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))
 	(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))
                (throw 'org-element--cache-interrupt nil))
 	      ((and future-change (>= limit future-change))
 	      ((and future-change (>= limit future-change))
 	       ;; Changes happened around this element and they will
 	       ;; Changes happened around this element and they will
@@ -6102,18 +6106,49 @@ completing the request."
 	       ;; and simply proceed with shifting (phase 2) to make
 	       ;; and simply proceed with shifting (phase 2) to make
 	       ;; sure that followup phase 0 request for the recent
 	       ;; sure that followup phase 0 request for the recent
 	       ;; changes can operate on the correctly shifted cache.
 	       ;; 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-parent request) nil)
                (setf (org-element--request-phase request) 2))
                (setf (org-element--request-phase request) 2))
 	      (t
 	      (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
                ;; No relevant changes happened after submitting this
                ;; request.  We are safe to look at the actual Org
                ;; request.  We are safe to look at the actual Org
                ;; buffer and calculate the new parent.
                ;; buffer and calculate the new parent.
 	       (let ((parent (org-element--parse-to (1- limit) nil time-limit)))
 	       (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-parent request) parent)
 		 (setf (org-element--request-phase request) 2))))))
 		 (setf (org-element--request-phase request) 2))))))
     ;; Phase 2.
     ;; Phase 2.
@@ -6138,7 +6173,7 @@ completing the request."
       ;; No re-parenting nor shifting planned: request is over.
       ;; No re-parenting nor shifting planned: request is over.
       (when (and (not parent) (zerop offset))
       (when (and (not parent) (zerop offset))
         (org-element--cache-log-message "Empty offset. Request completed.")
         (org-element--cache-log-message "Empty offset. Request completed.")
-        (throw 'quit t))
+        (throw 'org-element--cache-quit t))
       (while node
       (while node
 	(let* ((data (avl-tree--node-data node))
 	(let* ((data (avl-tree--node-data node))
 	       (key (org-element--cache-key data)))
 	       (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 (org-element--request-parent next-request))
                                   (org-element-property :begin parent)))
                                   (org-element-property :begin parent)))
                     (setf (org-element--request-parent next-request) parent)))
                     (setf (org-element--request-parent next-request) parent)))
-                (throw 'quit t))
+                (throw 'org-element--cache-quit t))
 	      ;; Handle interruption request.  Update current request.
 	      ;; Handle interruption request.  Update current request.
 	      (when (or exit-flag (org-element--cache-interrupt-p time-limit))
 	      (when (or exit-flag (org-element--cache-interrupt-p time-limit))
                 (org-element--cache-log-message "Interrupt: %s" (if exit-flag "threshold" "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
 		(while (and parent
 			    (<= (org-element-property :end parent) begin))
 			    (<= (org-element-property :end parent) begin))
 		  (setq parent (org-element-property :parent parent)))
 		  (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
                       ;; Consider scenario when DATA lays within
                       ;; sensitive lines of PARENT that was found
                       ;; sensitive lines of PARENT that was found
                       ;; during phase 2.  For example:
                       ;; during phase 2.  For example:
@@ -6245,7 +6280,7 @@ completing the request."
                          ;; else.
                          ;; 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-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)
                          (org-element-cache-reset)
-                         (throw 'quit t))
+                         (throw 'org-element--cache-quit t))
 		       (org-element-put-property data :parent parent)
 		       (org-element-put-property data :parent parent)
 		       (let ((s (org-element-property :structure parent)))
 		       (let ((s (org-element-property :structure parent)))
 			 (when (and s (org-element-property :structure data))
 			 (when (and s (org-element-property :structure data))
@@ -6264,9 +6299,9 @@ completing the request."
 			   (pop stack)))))))
 			   (pop stack)))))))
       ;; We reached end of tree: synchronization complete.
       ;; We reached end of tree: synchronization complete.
       t))
       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)
 (defsubst org-element--open-end-p (element)
   "Check if ELEMENT in current buffer contains extra blank lines after
   "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
         ;; yet to the otherwise correct part of the cache (i.e, before
         ;; the first request).
         ;; the first request).
         (org-element--cache-log-message "Adding new phase 0 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)))
         (let ((first (org-element--cache-for-removal beg end offset)))
 	  (if first
 	  (if first
 	      (push (let ((first-beg (org-element-property :begin 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.
 	    ;; Simply shift additional elements, if any, by OFFSET.
 	    (if org-element--cache-sync-requests
 	    (if org-element--cache-sync-requests
                 (progn
                 (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
                                        offset
                                        (let ((print-level 3))
                                        (let ((print-level 3))
                                          (car org-element--cache-sync-requests)))
                                          (car org-element--cache-sync-requests)))
 	          (cl-incf (org-element--request-offset (car org-element--cache-sync-requests))
 	          (cl-incf (org-element--request-offset (car org-element--cache-sync-requests))
 		           offset))
 		           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))))))
                                    end))))))
     (setq org-element--cache-change-warning nil)))
     (setq org-element--cache-change-warning nil)))