Function: org-element--cache-process-request
org-element--cache-process-request is a byte-compiled function defined
in org-element.el.gz.
Signature
(org-element--cache-process-request REQUEST NEXT-REQUEST-KEY THRESHOLD TIME-LIMIT FUTURE-CHANGE OFFSET)
Documentation
Process synchronization REQUEST for all entries before NEXT.
REQUEST is a vector, built by org-element--cache-submit-request.
NEXT-REQUEST-KEY is a cache key of the next request, as returned by
org-element--cache-key.
When non-nil, THRESHOLD is a buffer position. Synchronization 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. 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.
Source Code
;; Defined in /usr/src/emacs/lisp/org/org-element.el.gz
(defun org-element--cache-process-request
(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'.
NEXT-REQUEST-KEY is a cache key of the next request, as returned by
`org-element--cache-key'.
When non-nil, THRESHOLD is a buffer position. Synchronization
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. 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."
(org-with-base-buffer nil
(org-element--cache-log-message
"org-element-cache: Processing request %s up to %S-%S, next: %S"
(let ((print-length 10) (print-level 3)) (prin1-to-string request))
future-change
threshold
next-request-key)
(catch 'org-element--cache-quit
(when (= (org-element--request-phase request) 0)
;; Phase 0.
;;
;; Delete all elements starting after beginning of the element
;; with request key NEXT, but not after buffer position END.
;;
;; 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 'org-element--cache-end-phase
(let ((deletion-count 0))
(while t
(when (org-element--cache-interrupt-p time-limit)
(org-element--cache-log-message "Interrupt: time limit")
(throw 'org-element--cache-interrupt nil))
(let ((request-key (org-element--request-key request))
(end (org-element--request-end request))
(node (org-element--cache-root))
data data-key)
;; Find first element in cache with key REQUEST-KEY or
;; after it.
(while node
(let* ((element (avl-tree--node-data node))
(key (org-element--cache-key element)))
(cond
((org-element--cache-key-less-p key request-key)
(setq node (avl-tree--node-right node)))
((org-element--cache-key-less-p request-key key)
(setq data element
data-key key
node (avl-tree--node-left node)))
(t (setq data element
data-key key
node nil)))))
(if data
;; We found first element in cache starting at or
;; after REQUEST-KEY.
(let ((pos (org-element-begin data)))
;; FIXME: Maybe simply (< pos end)?
(if (<= pos end)
(progn
(org-element--cache-log-message "removing %S::%S"
(org-element-property :org-element--cache-sync-key data)
(org-element--format-element data))
(cl-incf deletion-count)
(org-element--cache-remove data)
(when (and (> (log org-element--cache-size 2) 10)
(> deletion-count
(/ org-element--cache-size (log org-element--cache-size 2))))
(org-element--cache-log-message "Removed %S>N/LogN(=%S/%S) elements. Resetting cache to prevent performance degradation"
deletion-count
org-element--cache-size
(log org-element--cache-size 2))
(org-element-cache-reset)
(throw 'org-element--cache-quit t)))
;; Done deleting everything 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 %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 '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 'org-element--cache-quit t)))))))
(when (= (org-element--request-phase request) 1)
;; Phase 1.
;;
;; Phase 0 left a hole in the cache. Some elements after it
;; could have parents within. For example, in the following
;; buffer:
;;
;; - item
;;
;;
;; Paragraph1
;;
;; Paragraph2
;;
;; if we remove a blank line between "item" and "Paragraph1",
;; everything down to "Paragraph2" is removed from cache. But
;; the paragraph now belongs to the list, and its `:parent'
;; property no longer is accurate.
;;
;; Therefore we need to parse again elements in the hole, or at
;; least in its last section, so that we can re-parent
;; subsequent elements, during phase 2.
;;
;; Note that we only need to get the parent from the first
;; element in cache after the hole.
;;
;; When next key is lesser or equal to the current one, current
;; request is inside a to-be-shifted part of the cache. It is
;; fine because the order of elements will not be altered by
;; shifting. However, we cannot know the real position of the
;; unshifted NEXT element in the current request. So, we need
;; to sort the request list according to keys and re-start
;; processing from the new leftmost request.
(org-element--cache-log-message "Phase 1")
(let ((key (org-element--request-key request)))
(when (and next-request-key (not (org-element--cache-key-less-p key next-request-key)))
;; In theory, the only case when requests are not
;; ordered is when key of the next request is either the
;; same with current key or it is a key for a removed
;; element. Either way, we can simply merge the two
;; requests.
(let ((next-request (nth 1 org-element--cache-sync-requests)))
(org-element--cache-log-message "Phase 1: Unorderered requests. Merging: %S\n%S\n"
(let ((print-length 10) (print-level 3)) (prin1-to-string request))
(let ((print-length 10) (print-level 3)) (prin1-to-string next-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 '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)))
cached-before)
(cond ((and threshold (> 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
;; trigger another phase 1 request. Skip re-parenting
;; 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 %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)))
(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-begin up)
(org-element-begin cached-before))))
(when (> (org-element-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))))
;; Cached elements cannot have deferred `:parent'.
(setq up (org-element-property-raw :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.
;;
;; Shift all elements starting from key START, but before NEXT, by
;; OFFSET, and re-parent them when appropriate.
;;
;; Elements are modified by side-effect so the tree structure
;; remains intact.
;;
;; Once THRESHOLD, if any, is reached, or once there is an input
;; pending, exit. Before leaving, the current synchronization
;; request is updated.
(org-element--cache-log-message "Phase 2")
(let ((start (org-element--request-key request))
(offset (org-element--request-offset request))
(parent (org-element--request-parent request))
(node (org-element--cache-root))
(stack (list nil))
(leftp t)
exit-flag continue-flag)
;; 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 'org-element--cache-quit t))
(while node
(let* ((data (avl-tree--node-data node))
(key (org-element--cache-key data)))
;; Traverse the cache tree. Ignore all the elements before
;; START. Note that `avl-tree-stack' would not bypass the
;; elements before START and thus would have been less
;; efficient.
(if (and leftp (avl-tree--node-left node)
(not (org-element--cache-key-less-p key start)))
(progn (push node stack)
(setq node (avl-tree--node-left node)))
;; Shift and re-parent when current node starts at or
;; after START, but before NEXT.
(unless (org-element--cache-key-less-p key start)
;; We reached NEXT. Request is complete.
(when (and next-request-key
(not (org-element--cache-key-less-p key next-request-key)))
(org-element--cache-log-message "Reached next request.")
(let ((next-request (nth 1 org-element--cache-sync-requests)))
(unless (and (org-element-property :cached (org-element--request-parent next-request))
(org-element-begin (org-element--request-parent next-request))
parent
(> (org-element-begin (org-element--request-parent next-request))
(org-element-begin parent)))
(setf (org-element--request-parent next-request) parent)))
(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"))
(setf (org-element--request-key request) key)
(setf (org-element--request-parent request) parent)
(throw 'org-element--cache-interrupt nil))
;; Shift element.
(when (>= org-element--cache-diagnostics-level 3)
(org-element--cache-log-message "Shifting positions (𝝙%S) in %S::%S"
offset
(org-element-property :org-element--cache-sync-key data)
(org-element--format-element data)))
(org-element--cache-shift-positions data offset)
(let ((begin (org-element-begin data)))
;; Update PARENT and re-parent DATA, only when
;; necessary. Propagate new structures for lists.
(while (and parent (<= (org-element-end parent) begin))
(setq parent
;; Cached elements cannot have deferred `:parent'.
(org-element-property-raw :parent parent)))
(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:
;;
;; #+ begin_quote
;; Paragraph
;; #+end_quote
;;
;; In the above source block, remove space in
;; the first line will trigger re-parenting of
;; the paragraph and "#+end_quote" that is also
;; considered paragraph before the modification.
;; However, the paragraph element stored in
;; cache must be deleted instead.
((and parent
(or (not (org-element-type-p parent org-element-greater-elements))
(and (org-element-contents-begin parent)
(< (org-element-begin data) (org-element-contents-begin parent)))
(and (org-element-contents-end parent)
(>= (org-element-begin data) (org-element-contents-end parent)))
(> (org-element-end data) (org-element-end parent))
(and (org-element-contents-end data)
(> (org-element-contents-end data) (org-element-contents-end parent)))))
(org-element--cache-log-message "org-element-cache: Removing obsolete element with key %S::%S"
(org-element-property :org-element--cache-sync-key data)
(org-element--format-element data))
(org-element--cache-remove data)
;; We altered the tree structure. The tree
;; traversal needs to be restarted.
(setf (org-element--request-key request) key)
;; Make sure that we restart tree traversal
;; past already shifted elements (before the
;; removed DATA).
(setq start key)
(setf (org-element--request-parent request) parent)
;; Restart tree traversal.
(setq node (org-element--cache-root)
stack (list nil)
leftp t
begin -1
continue-flag t))
((and parent
(not (eq parent data))
;; Cached elements cannot have deferred `:parent'.
(let ((p (org-element-property-raw :parent data)))
(or (not p)
(< (org-element-begin p)
(org-element-begin parent))
(unless (eq p parent)
(not (org-element-property :cached p))
;; (not (avl-tree-member-p org-element--cache p))
))))
(org-element--cache-log-message
"Updating parent in %S\n Old parent: %S\n New parent: %S"
(org-element--format-element data)
(org-element--format-element
(org-element-property-raw :parent data))
(org-element--format-element parent))
(when (and (org-element-type-p parent 'org-data)
(not (org-element-type-p data 'headline)))
;; FIXME: This check is here to see whether
;; such error happens within
;; `org-element--cache-process-request' or somewhere
;; else.
(org-element--cache-warn
"Added org-data parent to non-headline element: %S
If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)."
data)
(org-element-cache-reset)
(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))
(org-element-put-property data :structure s)))))
;; Cache is up-to-date past THRESHOLD. Request
;; interruption.
(when (and threshold (> begin threshold))
(org-element--cache-log-message "Reached threshold %S: %S"
threshold
(org-element--format-element data))
(setq exit-flag t))))
(if continue-flag
(setq continue-flag nil)
(setq node (if (setq leftp (avl-tree--node-right node))
(avl-tree--node-right node)
(pop stack)))))))
;; We reached end of tree: synchronization complete.
t))
(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)))))