0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-09-29 18:36:26 +00:00

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
This commit is contained in:
Ihor Radchenko 2021-12-17 22:48:20 +08:00
parent e2a8e95576
commit 4426d8009f
No known key found for this signature in database
GPG key ID: 6470762A7DA11D8B

View file

@ -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)))