mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-09-29 21:07:54 +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:
parent
e2a8e95576
commit
4426d8009f
|
@ -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"
|
||||
(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)))))))
|
||||
(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,15 +6106,46 @@ 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"
|
||||
(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))
|
||||
|
@ -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,7 +6299,7 @@ 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-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))))
|
||||
|
||||
|
@ -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)))
|
||||
|
||||
|
|
Loading…
Reference in a new issue