ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use cache in org-up-heading-safe 

* lisp/org.el (org-up-heading-safe): Use buffer-local cache to store
positions of parent headings.  The cache is invalidated when buffer
text is changed, according to `buffer-chars-modified-tick'.
(org--up-heading-cache):  Buffer-local hash-table storing the cache.
(org--up-heading-cache-tick):  The buffer modification state for
currently active `org--up-heading-cache'.

The optimisation is critical when running agenda or org-entry-get
queries using property/tag inheritance.  In such scenarios
`org-up-heading-safe' can be called thousands of times.  For example,
building todo agenda on large number of headings lead to the following
benchmark results:

Benchmark:

1. (elp-instrument-function #'org-up-heading-safe)
2. Run agenda
3. (elp-results) ;; function, # calls, total time, avg time

Without cache:
org-up-heading-safe  27555       8.4234025759  0.0003056941

With cache, first run:
org-up-heading-safe  23227       0.5300747539  2.282...e-05

With cache, second run on unchanged buffer:
org-up-heading-safe  23227       0.1447754880  6.233...e-06

The final speedup is 1-2 orders of magnitude (~15-56 times).
This commit is contained in:
Ihor Radchenko 2021-05-06 14:13:20 +08:00 committed by Bastien
parent 8b0b206b52
commit ba273278a5
1 changed files with 26 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lisp/org.el
View File

@ -20460,6 +20460,10 @@ This function considers both visible and invisible heading lines.
With argument, move up ARG levels." With argument, move up ARG levels."
(outline-up-heading arg t)) (outline-up-heading arg t))
(defvar-local org--up-heading-cache nil
"Buffer-local `org-up-heading-safe' cache.")
(defvar-local org--up-heading-cache-tick nil
"Buffer `buffer-chars-modified-tick' in `org--up-heading-cache'.")
(defun org-up-heading-safe () (defun org-up-heading-safe ()
"Move to the heading line of which the present line is a subheading. "Move to the heading line of which the present line is a subheading.
This version will not throw an error. It will return the level of the This version will not throw an error. It will return the level of the
@ -20469,10 +20473,28 @@ Also, this function will be a lot faster than `outline-up-heading',
because it relies on stars being the outline starters. This can really because it relies on stars being the outline starters. This can really
make a significant difference in outlines with very many siblings." make a significant difference in outlines with very many siblings."
(when (ignore-errors (org-back-to-heading t)) (when (ignore-errors (org-back-to-heading t))
(let ((level-up (1- (funcall outline-level)))) (let (level-cache)
(and (> level-up 0) (unless org--up-heading-cache
(re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t) (setq org--up-heading-cache (make-hash-table)))
(funcall outline-level))))) (if (and (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
(setq level-cache (gethash (point) org--up-heading-cache)))
(when (<= (point-min) (car level-cache) (point-max))
;; Parent is inside accessible part of the buffer.
(progn (goto-char (car level-cache))
(cdr level-cache)))
;; Buffer modified. Invalidate cache.
(unless (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
(setq-local org--up-heading-cache-tick
(buffer-chars-modified-tick))
(clrhash org--up-heading-cache))
(let* ((level-up (1- (funcall outline-level)))
(pos (point))
(result (and (> level-up 0)
(re-search-backward
(format "^\\*\\{1,%d\\} " level-up) nil t)
(funcall outline-level))))
(when result (puthash pos (cons (point) result) org--up-heading-cache))
result)))))
(defun org-up-heading-or-point-min () (defun org-up-heading-or-point-min ()
"Move to the heading line of which the present is a subheading, or point-min. "Move to the heading line of which the present is a subheading, or point-min.