mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

org-element: Optimize cache 

* lisp/org-element.el (org-element--cache-for-removal): New function.
(org-element--cache-submit-request): Do not synchronize cache when
changes can be merged with next request.

This shortcut is particularly useful when many changes happen in the
same area, which is expensive to parse (e.g., a large list).
This commit is contained in:
Nicolas Goaziou 2014-06-18 00:11:44 +02:00
parent b2f200f0a1
commit 8e49c823fd
1 changed files with 85 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

153
lisp/org-element.el
View File

@ -5491,79 +5491,96 @@ that range. See `after-change-functions' for more information."
;; Activate a timer to process the request during idle time. ;; Activate a timer to process the request during idle time.
(org-element--cache-set-timer (current-buffer))))) (org-element--cache-set-timer (current-buffer)))))
(defun org-element--cache-for-removal (beg end offset)
"Return first element to remove from cache.
BEG and END are buffer positions delimiting buffer modifications.
OFFSET is the size of the changes.
Returned element is usually the first element in cache containing
any position between BEG and END. As an exception, greater
elements around the changes that are robust to contents
modifications are preserved and updated according to the
changes."
(let* ((elements (org-element--cache-find (1- beg) 'both))
(before (car elements))
(after (cdr elements)))
(if (not before) after
(let ((up before))
(while (setq up (org-element-property :parent up))
(if (and (memq (org-element-type up)
'(center-block
drawer dynamic-block inlinetask
property-drawer quote-block special-block))
(<= (org-element-property :contents-begin up) beg)
(> (org-element-property :contents-end up) end))
;; UP is a robust greater element containing changes.
;; We only need to extend its ending boundaries and
;; those of all its parents.
(while up
(org-element--cache-shift-positions
up offset '(:contents-end :end))
(setq up (org-element-property :parent up)))
(setq before up)))
;; We're at top level element containing ELEMENT: if it's
;; altered by buffer modifications, it is first element in
;; cache to be removed. Otherwise, that first element is the
;; following one.
(if (< (org-element-property :end before) beg) after before)))))
(defun org-element--cache-submit-request (beg end offset) (defun org-element--cache-submit-request (beg end offset)
"Submit a new cache synchronization request for current buffer. "Submit a new cache synchronization request for current buffer.
BEG and END are buffer positions delimiting the minimal area BEG and END are buffer positions delimiting the minimal area
where cache data should be removed. OFFSET is the size of the where cache data should be removed. OFFSET is the size of the
change, as an integer." change, as an integer."
;; Make sure buffer positions in cache are correct until END. This (let ((next (car org-element--cache-sync-requests)))
;; also ensures that pending cache requests have their phases (if (and next
;; properly ordered. We need to provide OFFSET as optional (zerop (aref next 5))
;; parameter since current modifications are not known yet to the (let ((offset (aref next 3)))
;; otherwise correct part of the cache (i.e, before the first (and (>= (+ (aref next 2) offset) end)
;; request). (<= (+ (aref next 1) offset) end))))
(org-element--cache-sync (current-buffer) end offset) ;; Current changes can be merged with first sync request: we
(let ((first-element ;; can save a partial cache synchronization.
;; Find the position of the first element in cache to remove. (progn
;; (incf (aref next 2) offset)
;; Partially modified elements will be removed during request (incf (aref next 3) offset)
;; processing. As an exception, greater elements around the (when (> (aref next 1) beg)
;; changes that are robust to contents modifications are (let ((first (org-element--cache-for-removal beg end offset)))
;; preserved. (when first
;; (aset next 0 (org-element--cache-key first))
;; We look just before BEG because an element ending at BEG (aset next 1 (org-element-property :begin first))))))
;; needs to be removed too. ;; Ensure cache is correct up to END. Also make sure that NEXT,
(let* ((elements (org-element--cache-find (1- beg) 'both)) ;; if any, is no longer a 0-phase request, thus ensuring that
(before (car elements)) ;; phases are properly ordered. We need to provide OFFSET as
(after (cdr elements))) ;; optional parameter since current modifications are not known
(if (not before) after ;; yet to the otherwise correct part of the cache (i.e, before
(let ((up before)) ;; the first request).
(while (setq up (org-element-property :parent up)) (org-element--cache-sync (current-buffer) end offset)
(if (and (memq (org-element-type up) (let ((first (org-element--cache-for-removal beg end offset)))
'(center-block (cond
drawer dynamic-block inlinetask ;; Changes happened before the first known element. Shift
property-drawer quote-block special-block)) ;; the rest of the cache.
(<= (org-element-property :contents-begin up) beg) ((and first (> (org-element-property :begin first) end))
(> (org-element-property :contents-end up) end)) (push (vector (org-element--cache-key first) nil nil offset nil 2)
;; UP is a greater element that is wrapped around org-element--cache-sync-requests))
;; the changes. We only need to extend its ;; There is at least an element to remove. Find position
;; ending boundaries and those of all its ;; past every element containing END.
;; parents. (first
(while up (if (> (org-element-property :end first) end)
(org-element--cache-shift-positions (setq end (org-element-property :end first))
up offset '(:contents-end :end)) (let ((element (org-element--cache-find end)))
(setq up (org-element-property :parent up))) (setq end (org-element-property :end element))
(setq before up))) (let ((up element))
;; We're at top level element containing ELEMENT: if (while (and (setq up (org-element-property :parent up))
;; it's altered by buffer modifications, it is first (>= (org-element-property :begin up) beg))
;; element in cache to be removed. Otherwise, that (setq end (org-element-property :end up))))))
;; first element is the following one. (push (vector (org-element--cache-key first)
(if (< (org-element-property :end before) beg) after before)))))) (org-element-property :begin first)
(cond end offset nil 0)
;; Changes happened before the first known element. Shift the org-element--cache-sync-requests))
;; rest of the cache. ;; No element to remove. No need to re-parent either.
((and first-element (> (org-element-property :begin first-element) end)) ;; Simply shift additional elements, if any, by OFFSET.
(push (vector (org-element--cache-key first-element) nil nil offset nil 2) (org-element--cache-sync-requests (incf (aref next 3) offset)))))))
org-element--cache-sync-requests))
;; There is at least an element to remove. Find position past
;; every element containing END.
(first-element
(if (> (org-element-property :end first-element) end)
(setq end (org-element-property :end first-element))
(let ((element (org-element--cache-find end)))
(setq end (org-element-property :end element))
(let ((up element))
(while (and (setq up (org-element-property :parent up))
(>= (org-element-property :begin up) beg))
(setq end (org-element-property :end up))))))
(push (vector (org-element--cache-key first-element)
(org-element-property :begin first-element)
end offset nil 0)
org-element--cache-sync-requests))
;; No element to remove. No need to re-parent either. Simply
;; shift additional elements, if any, by OFFSET.
(org-element--cache-sync-requests
(incf (aref (car org-element--cache-sync-requests) 2) offset)))))
;;;; Public Functions ;;;; Public Functions