[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/org e3d690edf8 054/101: org-element-cache-map: Allow wh
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/org e3d690edf8 054/101: org-element-cache-map: Allow when cache is disabled |
|
Date: |
Sat, 1 Jul 2023 09:59:12 -0400 (EDT) |
branch: externals/org
commit e3d690edf8f3e3747b14d0d364521e32615d1783
Author: Ihor Radchenko <yantar92@posteo.net>
Commit: Ihor Radchenko <yantar92@posteo.net>
org-element-cache-map: Allow when cache is disabled
* lisp/org-element.el (org-element--cache-variables): New constant
holding variables involved in cache state.
(org-element-cache-reset): Fix modification hooks when cache is reset
and buffer already have indirect child buffers.
(org-element-with-enabled-cache): New macro, to enable cache around
body.
(org-element-cache-map): Enable cache when executing.
---
lisp/org-element.el | 887 +++++++++++++++++++++++++++-------------------------
1 file changed, 467 insertions(+), 420 deletions(-)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 3db77db02e..0da449937f 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -5492,6 +5492,17 @@ See `org-element--cache-key' for more information.")
(defvar-local org-element--cache-last-buffer-size nil
"Last value of `buffer-size' for registered changes.")
+(defconst org-element--cache-variables
+ '( org-element--cache org-element--cache-size
+ org-element--headline-cache org-element--headline-cache-size
+ org-element--cache-hash-left org-element--cache-hash-right
+ org-element--cache-sync-requests org-element--cache-sync-timer
+ org-element--cache-sync-keys-value org-element--cache-change-tic
+ org-element--cache-last-buffer-size
+ org-element--cache-gapless
+ org-element--cache-change-warning)
+ "List of variable symbols holding cache state.")
+
(defvar org-element--cache-non-modifying-commands
'(org-agenda
org-agenda-redo
@@ -7387,6 +7398,14 @@ the cache persistence in the buffer."
(setq-local org-element--cache-sync-requests nil)
(setq-local org-element--cache-sync-timer nil)
(org-element--cache-setup-change-functions)
+ ;; Install in the existing indirect buffers.
+ (dolist (buf (seq-filter
+ (lambda (buf)
+ (eq (current-buffer)
+ (buffer-base-buffer buf)))
+ (buffer-list)))
+ (with-current-buffer buf
+ (org-element--cache-setup-change-functions)))
;; Make sure that `org-element--cache-after-change' and
;; `org-element--cache-before-change' are working inside properly
created
;; indirect buffers. Note that `clone-indirect-buffer-hook'
@@ -7405,8 +7424,35 @@ the cache persistence in the buffer."
(org-element--cache-submit-request pos pos 0)
(org-element--cache-set-timer (current-buffer))))
-(defvar warning-minimum-log-level) ; Defined in warning.el
+(defmacro org-element-with-enabled-cache (&rest body)
+ "Run BODY with org-element cache enabled (maybe temporarily).
+When cache is enabled, just run body.
+When cache is disabled, initialize a new cache, run BODY, and cleanup
+at the end."
+ (declare (debug (form body)) (indent 0))
+ (org-with-gensyms (old-state buffer)
+ `(if (org-element--cache-active-p)
+ ;; Cache is active, just run BODY.
+ (progn ,@body)
+ ;; Cache is disabled.
+ ;; Save existing cache.
+ (let ((,buffer (current-buffer))
+ (,old-state
+ (org-with-base-buffer nil
+ (mapcar #'symbol-value org-element--cache-variables)))
+ (org-element-use-cache t))
+ (unwind-protect
+ (progn
+ (org-element-cache-reset)
+ ,@body)
+ (cl-mapc
+ (lambda (var values)
+ (org-with-base-buffer ,buffer
+ (set var values)))
+ org-element--cache-variables
+ ,old-state))))))
+(defvar warning-minimum-log-level) ; Defined in warning.el
(defvar org-element-cache-map-continue-from nil
"Position from where mapping should continue.
This variable can be set by called function, especially when the
@@ -7460,430 +7506,431 @@ This function does a subset of what `org-element-map'
does, but with
much better performance. Cached elements are supplied as the single
argument of FUNC. Changes to elements made in FUNC will also alter
the cache."
- (unless (org-element--cache-active-p)
- (error "Cache must be active."))
- (unless (memq granularity '( headline headline+inlinetask
- greater-element element))
- (error "Unsupported granularity: %S" granularity))
- ;; Make TO-POS marker. Otherwise, buffer edits may garble the the
- ;; process.
- (unless (markerp to-pos)
- (let ((mk (make-marker)))
- (set-marker mk to-pos)
- (setq to-pos mk)))
- (let (;; Bind variables used inside loop to avoid memory
- ;; re-allocation on every iteration.
- ;; See https://emacsconf.org/2021/talks/faster/
- tmpnext-start tmpparent tmpelement)
- (save-excursion
- (save-restriction
- (unless narrow (widen))
- ;; Synchronize cache up to the end of mapped region.
- (org-element-at-point to-pos)
- (cl-macrolet ((cache-root
- ;; Use the most optimal version of cache available.
- () `(org-with-base-buffer nil
- (if (memq granularity '(headline
headline+inlinetask))
- (org-element--headline-cache-root)
- (org-element--cache-root))))
- (cache-size
- ;; Use the most optimal version of cache available.
- () `(org-with-base-buffer nil
- (if (memq granularity '(headline
headline+inlinetask))
- org-element--headline-cache-size
- org-element--cache-size)))
- (cache-walk-restart
- ;; Restart tree traversal after AVL tree re-balance.
- () `(when node
- (org-element-at-point (point-max))
- (setq node (cache-root)
- stack (list nil)
- leftp t
- continue-flag t)))
- (cache-walk-abort
- ;; Abort tree traversal.
- () `(setq continue-flag t
- node nil))
- (element-match-at-point
- ;; Returning the first element to match around point.
- ;; For example, if point is inside headline and
- ;; granularity is restricted to headlines only, skip
- ;; over all the child elements inside the headline
- ;; and return the first parent headline.
- ;; When we are inside a cache gap, calling
- ;; `org-element-at-point' also fills the cache gap
down to
+ (org-element-with-enabled-cache
+ (unless (org-element--cache-active-p)
+ (error "Cache must be active."))
+ (unless (memq granularity '( headline headline+inlinetask
+ greater-element element))
+ (error "Unsupported granularity: %S" granularity))
+ ;; Make TO-POS marker. Otherwise, buffer edits may garble the the
+ ;; process.
+ (unless (markerp to-pos)
+ (let ((mk (make-marker)))
+ (set-marker mk to-pos)
+ (setq to-pos mk)))
+ (let (;; Bind variables used inside loop to avoid memory
+ ;; re-allocation on every iteration.
+ ;; See https://emacsconf.org/2021/talks/faster/
+ tmpnext-start tmpparent tmpelement)
+ (save-excursion
+ (save-restriction
+ (unless narrow (widen))
+ ;; Synchronize cache up to the end of mapped region.
+ (org-element-at-point to-pos)
+ (cl-macrolet ((cache-root
+ ;; Use the most optimal version of cache available.
+ () `(org-with-base-buffer nil
+ (if (memq granularity '(headline
headline+inlinetask))
+ (org-element--headline-cache-root)
+ (org-element--cache-root))))
+ (cache-size
+ ;; Use the most optimal version of cache available.
+ () `(org-with-base-buffer nil
+ (if (memq granularity '(headline
headline+inlinetask))
+ org-element--headline-cache-size
+ org-element--cache-size)))
+ (cache-walk-restart
+ ;; Restart tree traversal after AVL tree re-balance.
+ () `(when node
+ (org-element-at-point (point-max))
+ (setq node (cache-root)
+ stack (list nil)
+ leftp t
+ continue-flag t)))
+ (cache-walk-abort
+ ;; Abort tree traversal.
+ () `(setq continue-flag t
+ node nil))
+ (element-match-at-point
+ ;; Returning the first element to match around point.
+ ;; For example, if point is inside headline and
+ ;; granularity is restricted to headlines only, skip
+ ;; over all the child elements inside the headline
+ ;; and return the first parent headline.
+ ;; When we are inside a cache gap, calling
+ ;; `org-element-at-point' also fills the cache gap
down to
+ ;; point.
+ () `(progn
+ ;; Parsing is one of the performance
+ ;; bottlenecks. Make sure to optimize it as
+ ;; much as possible.
+ ;;
+ ;; Avoid extra staff like timer cancels et al
+ ;; and only call
`org-element--cache-sync-requests' when
+ ;; there are pending requests.
+ (org-with-base-buffer nil
+ (when org-element--cache-sync-requests
+ (org-element--cache-sync
(current-buffer))))
+ ;; Call `org-element--parse-to' directly
avoiding any
+ ;; kind of `org-element-at-point' overheads.
+ (if restrict-elements
+ ;; Search directly instead of calling
+ ;; `org-element-lineage' to avoid funcall
overheads
+ ;; and making sure that we do not go all
+ ;; the way to `org-data' as
`org-element-lineage'
+ ;; does.
+ (progn
+ (setq tmpelement (org-element--parse-to
(point)))
+ (while (and tmpelement (not
(org-element-type-p tmpelement restrict-elements)))
+ (setq tmpelement (org-element-parent
tmpelement)))
+ tmpelement)
+ (org-element--parse-to (point)))))
+ ;; Starting from (point), search RE and move START to
+ ;; the next valid element to be matched according to
+ ;; restriction. Abort cache walk if no next element
+ ;; can be found. When RE is nil, just find element at
;; point.
- () `(progn
- ;; Parsing is one of the performance
- ;; bottlenecks. Make sure to optimize it as
- ;; much as possible.
- ;;
- ;; Avoid extra staff like timer cancels et al
- ;; and only call
`org-element--cache-sync-requests' when
- ;; there are pending requests.
- (org-with-base-buffer nil
- (when org-element--cache-sync-requests
- (org-element--cache-sync (current-buffer))))
- ;; Call `org-element--parse-to' directly
avoiding any
- ;; kind of `org-element-at-point' overheads.
- (if restrict-elements
- ;; Search directly instead of calling
- ;; `org-element-lineage' to avoid funcall
overheads
- ;; and making sure that we do not go all
- ;; the way to `org-data' as
`org-element-lineage'
- ;; does.
- (progn
- (setq tmpelement (org-element--parse-to
(point)))
- (while (and tmpelement (not
(org-element-type-p tmpelement restrict-elements)))
- (setq tmpelement (org-element-parent
tmpelement)))
- tmpelement)
- (org-element--parse-to (point)))))
- ;; Starting from (point), search RE and move START to
- ;; the next valid element to be matched according to
- ;; restriction. Abort cache walk if no next element
- ;; can be found. When RE is nil, just find element at
- ;; point.
- (move-start-to-next-match
- ;; Preserve match data that might be set by FUNC.
- (re) `(save-match-data
- (if (or (not ,re)
- (if org-element--cache-map-statistics
- (progn
- (setq before-time (float-time))
- (re-search-forward (or (car-safe
,re) ,re) nil 'move)
- (cl-incf re-search-time
- (- (float-time)
- before-time)))
- (re-search-forward (or (car-safe
,re) ,re) nil 'move)))
- (unless (or (< (point) (or start -1))
- (and data
- (< (point)
(org-element-begin data))))
- (if (cdr-safe ,re)
- ;; Avoid parsing when we are 100%
- ;; sure that regexp is good enough
- ;; to find new START.
- (setq start (match-beginning 0))
- (setq start (max (or start -1)
- (or
(org-element-begin data) -1)
- (or
(org-element-begin (element-match-at-point)) -1))))
- (when (>= start to-pos)
(cache-walk-abort))
- (when (eq start -1) (setq start nil)))
- (cache-walk-abort))))
- ;; Find expected begin position of an element after
- ;; DATA.
- (next-element-start
- () `(progn
- (setq tmpnext-start nil)
- (if (memq granularity '(headline
headline+inlinetask))
- (setq tmpnext-start (or (when
(org-element-type-p data '(headline org-data))
+ (move-start-to-next-match
+ ;; Preserve match data that might be set by FUNC.
+ (re) `(save-match-data
+ (if (or (not ,re)
+ (if org-element--cache-map-statistics
+ (progn
+ (setq before-time (float-time))
+ (re-search-forward (or
(car-safe ,re) ,re) nil 'move)
+ (cl-incf re-search-time
+ (- (float-time)
+ before-time)))
+ (re-search-forward (or (car-safe
,re) ,re) nil 'move)))
+ (unless (or (< (point) (or start -1))
+ (and data
+ (< (point)
(org-element-begin data))))
+ (if (cdr-safe ,re)
+ ;; Avoid parsing when we are 100%
+ ;; sure that regexp is good enough
+ ;; to find new START.
+ (setq start (match-beginning 0))
+ (setq start (max (or start -1)
+ (or
(org-element-begin data) -1)
+ (or
(org-element-begin (element-match-at-point)) -1))))
+ (when (>= start to-pos)
(cache-walk-abort))
+ (when (eq start -1) (setq start nil)))
+ (cache-walk-abort))))
+ ;; Find expected begin position of an element after
+ ;; DATA.
+ (next-element-start
+ () `(progn
+ (setq tmpnext-start nil)
+ (if (memq granularity '(headline
headline+inlinetask))
+ (setq tmpnext-start (or (when
(org-element-type-p data '(headline org-data))
+
(org-element-contents-begin data))
+ (org-element-end
data)))
+ (setq tmpnext-start (or (when
(org-element-type-p data org-element-greater-elements)
(org-element-contents-begin data))
- (org-element-end
data)))
- (setq tmpnext-start (or (when
(org-element-type-p data org-element-greater-elements)
-
(org-element-contents-begin data))
- (org-element-end
data))))
- ;; DATA end may be the last element inside
- ;; i.e. source block. Skip up to the end
- ;; of parent in such case.
- (setq tmpparent data)
- (catch :exit
- (when (eq tmpnext-start
(org-element-contents-end tmpparent))
- (setq tmpnext-start (org-element-end
tmpparent)))
- (while (setq tmpparent (org-element-parent
tmpparent))
- (if (eq tmpnext-start
(org-element-contents-end tmpparent))
- (setq tmpnext-start (org-element-end
tmpparent))
- (throw :exit t))))
- tmpnext-start))
- ;; Check if cache does not have gaps.
- (cache-gapless-p
- () `(org-with-base-buffer nil
- (eq org-element--cache-change-tic
- (alist-get granularity
org-element--cache-gapless)))))
- ;; The core algorithm is simple walk along binary tree. However,
- ;; instead of checking all the tree elements from first to last
- ;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping
- ;; the elements before FROM-POS efficiently: O(logN) instead of
- ;; O(Nbefore).
- ;;
- ;; Later, we may also not check every single element in the
- ;; binary tree after FROM-POS. Instead, we can find position of
- ;; next candidate elements by means of regexp search and skip the
- ;; binary tree branches that are before the next candidate:
- ;; again, O(logN) instead of O(Nbetween).
- ;;
- ;; Some elements might not yet be in the tree. So, we also parse
- ;; the empty gaps in cache as needed making sure that we do not
- ;; miss anything.
- (let* (;; START is always beginning of an element. When there is
- ;; no element in cache at START, we are inside cache gap
- ;; and need to fill it.
- (start (and from-pos
- (progn
- (goto-char from-pos)
- (org-element-begin (element-match-at-point)))))
- ;; Some elements may start at the same position, so we
- ;; also keep track of the last processed element and make
- ;; sure that we do not try to search it again.
- (prev after-element)
- (node (cache-root))
- data
- (stack (list nil))
- (leftp t)
- result
- ;; Whether previous element matched FUNC (FUNC
- ;; returned non-nil).
- (last-match t)
- continue-flag
- ;; Generic regexp to search next potential match. If it
- ;; is a cons of (regexp . 'match-beg), we are 100% sure
- ;; that the match beginning is the existing element
- ;; beginning.
- (next-element-re (pcase granularity
- ((or `headline
- (guard (equal '(headline)
- restrict-elements)))
- (cons
- (org-with-limited-levels
- org-element-headline-re)
- 'match-beg))
- (`headline+inlinetask
- (cons
- (if (equal '(inlinetask)
restrict-elements)
- (org-inlinetask-outline-regexp)
- org-element-headline-re)
- 'match-beg))
- ;; TODO: May add other commonly
- ;; searched elements as needed.
- (_)))
- ;; Make sure that we are not checking the same regexp twice.
- (next-re (unless (and next-re
- (string= next-re
- (or (car-safe next-element-re)
- next-element-re)))
- next-re))
- (fail-re (unless (and fail-re
- (string= fail-re
- (or (car-safe next-element-re)
- next-element-re)))
- fail-re))
- (restrict-elements (or restrict-elements
- (pcase granularity
- (`headline
- '(headline))
- (`headline+inlinetask
- '(headline inlinetask))
- (`greater-element
- org-element-greater-elements)
- (_ nil))))
- ;; Statistics
- (time (float-time))
- (predicate-time 0)
- (pre-process-time 0)
- (re-search-time 0)
- (count-predicate-calls-match 0)
- (count-predicate-calls-fail 0)
- ;; Bind variables used inside loop to avoid memory
- ;; re-allocation on every iteration.
- ;; See https://emacsconf.org/2021/talks/faster/
- cache-size before-time modified-tic)
- ;; Skip to first element within region.
- (goto-char (or start (point-min)))
- (move-start-to-next-match next-element-re)
- (unless (and start (>= start to-pos))
- (while node
- (setq data (avl-tree--node-data node))
- (if (and leftp (avl-tree--node-left node) ; Left branch.
- ;; Do not move to left branch when we are before
- ;; PREV.
- (or (not prev)
- (not (org-element--cache-key-less-p
- (org-element--cache-key data)
- (org-element--cache-key prev))))
- ;; ... or when we are before START.
- (or (not start)
- (not (> start (org-element-begin data)))))
- (progn (push node stack)
- (setq node (avl-tree--node-left node)))
- ;; The whole tree left to DATA is before START and
- ;; PREV. DATA may still be before START (i.e. when
- ;; DATA is the root or when START moved), at START, or
- ;; after START.
- ;;
- ;; If DATA is before start, skip it over and move to
- ;; subsequent elements.
- ;; If DATA is at start, run FUNC if necessary and
- ;; update START according and NEXT-RE, FAIL-RE,
- ;; NEXT-ELEMENT-RE.
- ;; If DATA is after start, we have found a cache gap
- ;; and need to fill it.
- (unless (or (and start (< (org-element-begin data) start))
- (and prev (not (org-element--cache-key-less-p
- (org-element--cache-key prev)
- (org-element--cache-key data)))))
- ;; DATA is at of after START and PREV.
- (if (or (not start) (= (org-element-begin data) start))
- ;; DATA is at START. Match it.
- ;; In the process, we may alter the buffer,
- ;; so also keep track of the cache state.
- (progn
- (setq modified-tic
- (org-with-base-buffer nil
- org-element--cache-change-tic))
- (setq cache-size (cache-size))
- ;; When NEXT-RE/FAIL-RE is provided, skip to
- ;; next regexp match after :begin of the current
- ;; element.
- (when (if last-match next-re fail-re)
- (goto-char (org-element-begin data))
- (move-start-to-next-match
- (if last-match next-re fail-re)))
- (when (and (or (not start) (eq (org-element-begin
data) start))
- (< (org-element-begin data) to-pos))
- ;; Calculate where next possible element
- ;; starts and update START if needed.
- (setq start (next-element-start))
- (goto-char start)
- ;; Move START further if possible.
- (when (and next-element-re
- ;; Do not move if we know for
- ;; sure that cache does not
- ;; contain gaps. Regexp
- ;; searches are not cheap.
- (not (cache-gapless-p)))
- (move-start-to-next-match next-element-re)
- ;; Make sure that point is at START
- ;; before running FUNC.
- (goto-char start))
- ;; Try FUNC if DATA matches all the
- ;; restrictions. Calculate new START.
- (when (or (not restrict-elements)
- (org-element-type-p data
restrict-elements))
- ;; DATA matches restriction. FUNC may
- ;;
- ;; Call FUNC. FUNC may move point.
- (setq org-element-cache-map-continue-from nil)
- (if (org-with-base-buffer nil
org-element--cache-map-statistics)
- (progn
- (setq before-time (float-time))
- (push (funcall func data) result)
- (cl-incf predicate-time
- (- (float-time)
- before-time))
- (if (car result)
- (cl-incf count-predicate-calls-match)
- (cl-incf count-predicate-calls-fail)))
- (push (funcall func data) result)
- (when (car result) (cl-incf
count-predicate-calls-match)))
- ;; Set `last-match'.
- (setq last-match (car result))
- ;; If FUNC moved point forward, update
- ;; START.
- (when org-element-cache-map-continue-from
- (goto-char
org-element-cache-map-continue-from))
- (when (> (point) start)
- (move-start-to-next-match nil)
- ;; (point) inside matching element.
- ;; Go further.
- (when (> (point) start)
- (setq data (element-match-at-point))
- (if (not data)
- (cache-walk-abort)
- (goto-char (next-element-start))
- (move-start-to-next-match
next-element-re))))
- ;; Drop nil.
- (unless (car result) (pop result)))
- ;; If FUNC did not move the point and we
- ;; know for sure that cache does not contain
- ;; gaps, do not try to calculate START in
- ;; advance but simply loop to the next cache
+ (org-element-end
data))))
+ ;; DATA end may be the last element inside
+ ;; i.e. source block. Skip up to the end
+ ;; of parent in such case.
+ (setq tmpparent data)
+ (catch :exit
+ (when (eq tmpnext-start
(org-element-contents-end tmpparent))
+ (setq tmpnext-start (org-element-end
tmpparent)))
+ (while (setq tmpparent (org-element-parent
tmpparent))
+ (if (eq tmpnext-start
(org-element-contents-end tmpparent))
+ (setq tmpnext-start (org-element-end
tmpparent))
+ (throw :exit t))))
+ tmpnext-start))
+ ;; Check if cache does not have gaps.
+ (cache-gapless-p
+ () `(org-with-base-buffer nil
+ (eq org-element--cache-change-tic
+ (alist-get granularity
org-element--cache-gapless)))))
+ ;; The core algorithm is simple walk along binary tree. However,
+ ;; instead of checking all the tree elements from first to last
+ ;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping
+ ;; the elements before FROM-POS efficiently: O(logN) instead of
+ ;; O(Nbefore).
+ ;;
+ ;; Later, we may also not check every single element in the
+ ;; binary tree after FROM-POS. Instead, we can find position of
+ ;; next candidate elements by means of regexp search and skip the
+ ;; binary tree branches that are before the next candidate:
+ ;; again, O(logN) instead of O(Nbetween).
+ ;;
+ ;; Some elements might not yet be in the tree. So, we also parse
+ ;; the empty gaps in cache as needed making sure that we do not
+ ;; miss anything.
+ (let* (;; START is always beginning of an element. When there is
+ ;; no element in cache at START, we are inside cache gap
+ ;; and need to fill it.
+ (start (and from-pos
+ (progn
+ (goto-char from-pos)
+ (org-element-begin
(element-match-at-point)))))
+ ;; Some elements may start at the same position, so we
+ ;; also keep track of the last processed element and make
+ ;; sure that we do not try to search it again.
+ (prev after-element)
+ (node (cache-root))
+ data
+ (stack (list nil))
+ (leftp t)
+ result
+ ;; Whether previous element matched FUNC (FUNC
+ ;; returned non-nil).
+ (last-match t)
+ continue-flag
+ ;; Generic regexp to search next potential match. If it
+ ;; is a cons of (regexp . 'match-beg), we are 100% sure
+ ;; that the match beginning is the existing element
+ ;; beginning.
+ (next-element-re (pcase granularity
+ ((or `headline
+ (guard (equal '(headline)
+ restrict-elements)))
+ (cons
+ (org-with-limited-levels
+ org-element-headline-re)
+ 'match-beg))
+ (`headline+inlinetask
+ (cons
+ (if (equal '(inlinetask)
restrict-elements)
+ (org-inlinetask-outline-regexp)
+ org-element-headline-re)
+ 'match-beg))
+ ;; TODO: May add other commonly
+ ;; searched elements as needed.
+ (_)))
+ ;; Make sure that we are not checking the same regexp twice.
+ (next-re (unless (and next-re
+ (string= next-re
+ (or (car-safe
next-element-re)
+ next-element-re)))
+ next-re))
+ (fail-re (unless (and fail-re
+ (string= fail-re
+ (or (car-safe
next-element-re)
+ next-element-re)))
+ fail-re))
+ (restrict-elements (or restrict-elements
+ (pcase granularity
+ (`headline
+ '(headline))
+ (`headline+inlinetask
+ '(headline inlinetask))
+ (`greater-element
+ org-element-greater-elements)
+ (_ nil))))
+ ;; Statistics
+ (time (float-time))
+ (predicate-time 0)
+ (pre-process-time 0)
+ (re-search-time 0)
+ (count-predicate-calls-match 0)
+ (count-predicate-calls-fail 0)
+ ;; Bind variables used inside loop to avoid memory
+ ;; re-allocation on every iteration.
+ ;; See https://emacsconf.org/2021/talks/faster/
+ cache-size before-time modified-tic)
+ ;; Skip to first element within region.
+ (goto-char (or start (point-min)))
+ (move-start-to-next-match next-element-re)
+ (unless (and start (>= start to-pos))
+ (while node
+ (setq data (avl-tree--node-data node))
+ (if (and leftp (avl-tree--node-left node) ; Left branch.
+ ;; Do not move to left branch when we are before
+ ;; PREV.
+ (or (not prev)
+ (not (org-element--cache-key-less-p
+ (org-element--cache-key data)
+ (org-element--cache-key prev))))
+ ;; ... or when we are before START.
+ (or (not start)
+ (not (> start (org-element-begin data)))))
+ (progn (push node stack)
+ (setq node (avl-tree--node-left node)))
+ ;; The whole tree left to DATA is before START and
+ ;; PREV. DATA may still be before START (i.e. when
+ ;; DATA is the root or when START moved), at START, or
+ ;; after START.
+ ;;
+ ;; If DATA is before start, skip it over and move to
+ ;; subsequent elements.
+ ;; If DATA is at start, run FUNC if necessary and
+ ;; update START according and NEXT-RE, FAIL-RE,
+ ;; NEXT-ELEMENT-RE.
+ ;; If DATA is after start, we have found a cache gap
+ ;; and need to fill it.
+ (unless (or (and start (< (org-element-begin data) start))
+ (and prev (not (org-element--cache-key-less-p
+ (org-element--cache-key prev)
+ (org-element--cache-key
data)))))
+ ;; DATA is at of after START and PREV.
+ (if (or (not start) (= (org-element-begin data) start))
+ ;; DATA is at START. Match it.
+ ;; In the process, we may alter the buffer,
+ ;; so also keep track of the cache state.
+ (progn
+ (setq modified-tic
+ (org-with-base-buffer nil
+ org-element--cache-change-tic))
+ (setq cache-size (cache-size))
+ ;; When NEXT-RE/FAIL-RE is provided, skip to
+ ;; next regexp match after :begin of the current
;; element.
- (when (and (cache-gapless-p)
- (eq (next-element-start)
- start))
- (setq start nil))
- ;; Reached LIMIT-COUNT. Abort.
- (when (and limit-count
- (>= count-predicate-calls-match
- limit-count))
- (cache-walk-abort)))
- ;; Check if the buffer or cache has been modified.
- (unless (org-with-base-buffer nil
- (and (eq modified-tic
org-element--cache-change-tic)
- (eq cache-size (cache-size))))
- ;; START may no longer be valid, update
- ;; it to beginning of real element.
- ;; Upon modification, START may lay
- ;; inside an element. We want to move
- ;; it to real beginning then despite
- ;; START being larger.
- (setq start nil)
- (let ((data nil)) ; data may not be valid. ignore
it.
- (move-start-to-next-match nil))
- ;; The new element may now start before
- ;; or at already processed position.
- ;; Make sure that we continue from an
- ;; element past already processed
- ;; place.
- (when (and start
- (<= start (org-element-begin data))
- (not
org-element-cache-map-continue-from))
+ (when (if last-match next-re fail-re)
+ (goto-char (org-element-begin data))
+ (move-start-to-next-match
+ (if last-match next-re fail-re)))
+ (when (and (or (not start) (eq (org-element-begin
data) start))
+ (< (org-element-begin data) to-pos))
+ ;; Calculate where next possible element
+ ;; starts and update START if needed.
+ (setq start (next-element-start))
(goto-char start)
- (setq data (element-match-at-point))
- ;; If DATA is nil, buffer is
- ;; empty. Abort.
- (when data
- (goto-char (next-element-start))
- (move-start-to-next-match next-element-re)))
- (org-element-at-point to-pos)
- (cache-walk-restart))
- (if (org-element-property :cached data)
- (setq prev data)
- (setq prev nil)))
- ;; DATA is after START. Fill the gap.
- (if (org-element-type-p
- (org-element--parse-to start)
- '(plain-list table))
- ;; Tables and lists are special, we need a
- ;; trickery to make items/rows be populated
- ;; into cache.
- (org-element--parse-to (1+ start)))
- ;; Restart tree traversal as AVL tree is
- ;; re-balanced upon adding elements. We can no
- ;; longer trust STACK.
- (cache-walk-restart)))
- ;; Second, move to the right branch of the tree or skip
- ;; it altogether.
- (if continue-flag
- (setq continue-flag nil)
- (setq node (if (and (car stack)
- ;; If START advanced beyond stack
parent, skip the right branch.
- (or (and start (< (org-element-begin
(avl-tree--node-data (car stack))) start))
- (and prev
(org-element--cache-key-less-p
- (org-element--cache-key
(avl-tree--node-data (car stack)))
- (org-element--cache-key
prev)))))
- (progn
- (setq leftp nil)
- (pop stack))
- ;; Otherwise, move ahead into the right
- ;; branch when it exists.
- (if (setq leftp (avl-tree--node-right node))
- (avl-tree--node-right node)
- (pop stack))))))))
- (when (and org-element--cache-map-statistics
- (or (not org-element--cache-map-statistics-threshold)
- (> (- (float-time) time)
org-element--cache-map-statistics-threshold)))
- (message "Mapped over elements in %S. %d/%d predicate matches.
Total time: %f sec. Pre-process time: %f sec. Predicate time: %f sec. Re-search
time: %f sec.
+ ;; Move START further if possible.
+ (when (and next-element-re
+ ;; Do not move if we know for
+ ;; sure that cache does not
+ ;; contain gaps. Regexp
+ ;; searches are not cheap.
+ (not (cache-gapless-p)))
+ (move-start-to-next-match next-element-re)
+ ;; Make sure that point is at START
+ ;; before running FUNC.
+ (goto-char start))
+ ;; Try FUNC if DATA matches all the
+ ;; restrictions. Calculate new START.
+ (when (or (not restrict-elements)
+ (org-element-type-p data
restrict-elements))
+ ;; DATA matches restriction. FUNC may
+ ;;
+ ;; Call FUNC. FUNC may move point.
+ (setq org-element-cache-map-continue-from nil)
+ (if (org-with-base-buffer nil
org-element--cache-map-statistics)
+ (progn
+ (setq before-time (float-time))
+ (push (funcall func data) result)
+ (cl-incf predicate-time
+ (- (float-time)
+ before-time))
+ (if (car result)
+ (cl-incf count-predicate-calls-match)
+ (cl-incf count-predicate-calls-fail)))
+ (push (funcall func data) result)
+ (when (car result) (cl-incf
count-predicate-calls-match)))
+ ;; Set `last-match'.
+ (setq last-match (car result))
+ ;; If FUNC moved point forward, update
+ ;; START.
+ (when org-element-cache-map-continue-from
+ (goto-char
org-element-cache-map-continue-from))
+ (when (> (point) start)
+ (move-start-to-next-match nil)
+ ;; (point) inside matching element.
+ ;; Go further.
+ (when (> (point) start)
+ (setq data (element-match-at-point))
+ (if (not data)
+ (cache-walk-abort)
+ (goto-char (next-element-start))
+ (move-start-to-next-match
next-element-re))))
+ ;; Drop nil.
+ (unless (car result) (pop result)))
+ ;; If FUNC did not move the point and we
+ ;; know for sure that cache does not contain
+ ;; gaps, do not try to calculate START in
+ ;; advance but simply loop to the next cache
+ ;; element.
+ (when (and (cache-gapless-p)
+ (eq (next-element-start)
+ start))
+ (setq start nil))
+ ;; Reached LIMIT-COUNT. Abort.
+ (when (and limit-count
+ (>= count-predicate-calls-match
+ limit-count))
+ (cache-walk-abort)))
+ ;; Check if the buffer or cache has been modified.
+ (unless (org-with-base-buffer nil
+ (and (eq modified-tic
org-element--cache-change-tic)
+ (eq cache-size (cache-size))))
+ ;; START may no longer be valid, update
+ ;; it to beginning of real element.
+ ;; Upon modification, START may lay
+ ;; inside an element. We want to move
+ ;; it to real beginning then despite
+ ;; START being larger.
+ (setq start nil)
+ (let ((data nil)) ; data may not be valid.
ignore it.
+ (move-start-to-next-match nil))
+ ;; The new element may now start before
+ ;; or at already processed position.
+ ;; Make sure that we continue from an
+ ;; element past already processed
+ ;; place.
+ (when (and start
+ (<= start (org-element-begin data))
+ (not
org-element-cache-map-continue-from))
+ (goto-char start)
+ (setq data (element-match-at-point))
+ ;; If DATA is nil, buffer is
+ ;; empty. Abort.
+ (when data
+ (goto-char (next-element-start))
+ (move-start-to-next-match next-element-re)))
+ (org-element-at-point to-pos)
+ (cache-walk-restart))
+ (if (org-element-property :cached data)
+ (setq prev data)
+ (setq prev nil)))
+ ;; DATA is after START. Fill the gap.
+ (if (org-element-type-p
+ (org-element--parse-to start)
+ '(plain-list table))
+ ;; Tables and lists are special, we need a
+ ;; trickery to make items/rows be populated
+ ;; into cache.
+ (org-element--parse-to (1+ start)))
+ ;; Restart tree traversal as AVL tree is
+ ;; re-balanced upon adding elements. We can no
+ ;; longer trust STACK.
+ (cache-walk-restart)))
+ ;; Second, move to the right branch of the tree or skip
+ ;; it altogether.
+ (if continue-flag
+ (setq continue-flag nil)
+ (setq node (if (and (car stack)
+ ;; If START advanced beyond stack
parent, skip the right branch.
+ (or (and start (< (org-element-begin
(avl-tree--node-data (car stack))) start))
+ (and prev
(org-element--cache-key-less-p
+
(org-element--cache-key (avl-tree--node-data (car stack)))
+
(org-element--cache-key prev)))))
+ (progn
+ (setq leftp nil)
+ (pop stack))
+ ;; Otherwise, move ahead into the right
+ ;; branch when it exists.
+ (if (setq leftp (avl-tree--node-right node))
+ (avl-tree--node-right node)
+ (pop stack))))))))
+ (when (and org-element--cache-map-statistics
+ (or (not org-element--cache-map-statistics-threshold)
+ (> (- (float-time) time)
org-element--cache-map-statistics-threshold)))
+ (message "Mapped over elements in %S. %d/%d predicate matches.
Total time: %f sec. Pre-process time: %f sec. Predicate time: %f sec. Re-search
time: %f sec.
Calling parameters: :granularity %S :restrict-elements %S :next-re %S
:fail-re %S :from-pos %S :to-pos %S :limit-count %S :after-element %S"
- (current-buffer)
- count-predicate-calls-match
- (+ count-predicate-calls-match
- count-predicate-calls-fail)
- (- (float-time) time)
- pre-process-time
- predicate-time
- re-search-time
- granularity restrict-elements next-re fail-re from-pos
to-pos limit-count after-element))
- ;; Return result.
- (nreverse result)))))))
+ (current-buffer)
+ count-predicate-calls-match
+ (+ count-predicate-calls-match
+ count-predicate-calls-fail)
+ (- (float-time) time)
+ pre-process-time
+ predicate-time
+ re-search-time
+ granularity restrict-elements next-re fail-re
from-pos to-pos limit-count after-element))
+ ;; Return result.
+ (nreverse result))))))))
- [elpa] externals/org 6b20a23065 010/101: org-element-ast: New function `org-element-type-p', (continued)
- [elpa] externals/org 6b20a23065 010/101: org-element-ast: New function `org-element-type-p', ELPA Syncer, 2023/07/01
- [elpa] externals/org f4aa3747e1 014/101: org-element: Preserve order of multiple affiliated keywords, ELPA Syncer, 2023/07/01
- [elpa] externals/org 71e2ea5698 025/101: org-element: Update docstrings using new syntax node terminology, ELPA Syncer, 2023/07/01
- [elpa] externals/org ad75fd2bae 016/101: org-element: Use `org-element-create' when parsing, ELPA Syncer, 2023/07/01
- [elpa] externals/org daebeb6446 020/101: org-element-inlinetask-parser: Use deferred properties, ELPA Syncer, 2023/07/01
- [elpa] externals/org 23f9347d1a 024/101: org-element-map: Allow TYPES t and add new arg NO-UNDEFER, ELPA Syncer, 2023/07/01
- [elpa] externals/org 2d22d7f515 036/101: ox.el: Rename `org-element-get-parent-element' and move to org-element, ELPA Syncer, 2023/07/01
- [elpa] externals/org 6a7aee2c35 034/101: org-texinfo--normalize-headlines: Use `org-element-create', ELPA Syncer, 2023/07/01
- [elpa] externals/org 3b1693c461 043/101: org-back-to-heading: Use org-element API, ELPA Syncer, 2023/07/01
- [elpa] externals/org eb0a293a02 048/101: Remove 'org-category text property cache, ELPA Syncer, 2023/07/01
- [elpa] externals/org e3d690edf8 054/101: org-element-cache-map: Allow when cache is disabled,
ELPA Syncer <=
- [elpa] externals/org ebbdd67a2a 059/101: Remove effort property cache, ELPA Syncer, 2023/07/01
- [elpa] externals/org c22697f472 023/101: Use new function names `org-element-extract' and `org-element-set', ELPA Syncer, 2023/07/01
- [elpa] externals/org a06dc07cc0 028/101: org-element: Defer more when parsing headings and inlinetasks, ELPA Syncer, 2023/07/01
- [elpa] externals/org ea4f4fdf58 035/101: Rename `org-export-get-parent' to `org-element-parent', ELPA Syncer, 2023/07/01
- [elpa] externals/org a2730b47fa 032/101: org-odt--paragraph-style: Use `org-element-lineage', ELPA Syncer, 2023/07/01
- [elpa] externals/org a43cc8c9aa 033/101: org-export-get-node-property: Use `org-element-property-inherited', ELPA Syncer, 2023/07/01
- [elpa] externals/org bc29f5de41 038/101: org-element: New `org-element-*property*' functions, ELPA Syncer, 2023/07/01
- [elpa] externals/org 7cbc441915 044/101: org-entry-get-with-inheritance: Use org-element API, ELPA Syncer, 2023/07/01
- [elpa] externals/org 31d53cb015 056/101: org-end-of-subtree: Use org-element API, ELPA Syncer, 2023/07/01
- [elpa] externals/org 7dee228569 063/101: org-element-at-point-no-context: Update docstring, ELPA Syncer, 2023/07/01