|
@@ -7109,7 +7109,11 @@ the cache."
|
|
|
(setq to-pos mk)))
|
|
|
;; Make sure that garbage collector does not stand on the way to
|
|
|
;; maximum performance.
|
|
|
- (let ((gc-cons-threshold #x40000000))
|
|
|
+ (let ((gc-cons-threshold #x40000000)
|
|
|
+ ;; 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))
|
|
@@ -7138,37 +7142,38 @@ the cache."
|
|
|
() `(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 optimise 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.
|
|
|
- (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.
|
|
|
- (let ((el (org-element--parse-to (point))))
|
|
|
- (while (and el (not (memq (org-element-type el) restrict-elements)))
|
|
|
- (setq el (org-element-property :parent el)))
|
|
|
- el)
|
|
|
- (org-element--parse-to (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 optimise 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.
|
|
|
+ (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 (memq (org-element-type tmpelement) restrict-elements)))
|
|
|
+ (setq tmpelement (org-element-property :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
|
|
@@ -7176,7 +7181,14 @@ the cache."
|
|
|
;; point.
|
|
|
(move-start-to-next-match
|
|
|
(re) `(save-match-data
|
|
|
- (if (or (not ,re) (re-search-forward (or (car-safe ,re) ,re) nil 'move))
|
|
|
+ (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-property :begin data))))
|
|
@@ -7193,26 +7205,27 @@ the cache."
|
|
|
;; Find expected begin position of an element after
|
|
|
;; DATA.
|
|
|
(next-element-start
|
|
|
- (data) `(let (next-start)
|
|
|
- (if (memq granularity '(headline headline+inlinetask))
|
|
|
- (setq next-start (or (when (memq (org-element-type data) '(headline org-data))
|
|
|
- (org-element-property :contents-begin data))
|
|
|
- (org-element-property :end data)))
|
|
|
- (setq next-start (or (when (memq (org-element-type data) org-element-greater-elements)
|
|
|
- (org-element-property :contents-begin data))
|
|
|
- (org-element-property :end data))))
|
|
|
- ;; DATA end may be the last element inside
|
|
|
- ;; i.e. source block. Skip up to the end
|
|
|
- ;; of parent in such case.
|
|
|
- (let ((parent data))
|
|
|
- (catch :exit
|
|
|
- (when (eq next-start (org-element-property :contents-end parent))
|
|
|
- (setq next-start (org-element-property :end parent)))
|
|
|
- (while (setq parent (org-element-property :parent parent))
|
|
|
- (if (eq next-start (org-element-property :contents-end parent))
|
|
|
- (setq next-start (org-element-property :end parent))
|
|
|
- (throw :exit t)))))
|
|
|
- next-start))
|
|
|
+ () `(progn
|
|
|
+ (setq tmpnext-start nil)
|
|
|
+ (if (memq granularity '(headline headline+inlinetask))
|
|
|
+ (setq tmpnext-start (or (when (memq (org-element-type data) '(headline org-data))
|
|
|
+ (org-element-property :contents-begin data))
|
|
|
+ (org-element-property :end data)))
|
|
|
+ (setq tmpnext-start (or (when (memq (org-element-type data) org-element-greater-elements)
|
|
|
+ (org-element-property :contents-begin data))
|
|
|
+ (org-element-property :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-property :contents-end tmpparent))
|
|
|
+ (setq tmpnext-start (org-element-property :end tmpparent)))
|
|
|
+ (while (setq tmpparent (org-element-property :parent tmpparent))
|
|
|
+ (if (eq tmpnext-start (org-element-property :contents-end tmpparent))
|
|
|
+ (setq tmpnext-start (org-element-property :end tmpparent))
|
|
|
+ (throw :exit t))))
|
|
|
+ tmpnext-start))
|
|
|
;; Check if cache does not have gaps.
|
|
|
(cache-gapless-p
|
|
|
() `(eq org-element--cache-change-tic
|
|
@@ -7327,8 +7340,13 @@ the cache."
|
|
|
(time (float-time))
|
|
|
(predicate-time 0)
|
|
|
(pre-process-time 0)
|
|
|
+ (re-search-time 0)
|
|
|
(count-predicate-calls-match 0)
|
|
|
- (count-predicate-calls-fail 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)
|
|
@@ -7343,13 +7361,13 @@ the cache."
|
|
|
(and (eq granularity 'element)
|
|
|
(or next-re fail-re)))
|
|
|
(let ((org-element-cache-map--recurse t))
|
|
|
- (let ((before-time (float-time)))
|
|
|
- (org-element-cache-map
|
|
|
- #'ignore
|
|
|
- :granularity granularity)
|
|
|
- (cl-incf pre-process-time
|
|
|
- (- (float-time)
|
|
|
- before-time)))
|
|
|
+ (setq before-time (float-time))
|
|
|
+ (org-element-cache-map
|
|
|
+ #'ignore
|
|
|
+ :granularity granularity)
|
|
|
+ (cl-incf pre-process-time
|
|
|
+ (- (float-time)
|
|
|
+ before-time))
|
|
|
;; Re-assign the cache root after filling the cache
|
|
|
;; gaps.
|
|
|
(setq node (cache-root)))
|
|
@@ -7390,8 +7408,9 @@ the cache."
|
|
|
;; DATA is at START. Match it.
|
|
|
;; In the process, we may alter the buffer,
|
|
|
;; so also keep track of the cache state.
|
|
|
- (let ((modified-tic org-element--cache-change-tic)
|
|
|
- (cache-size (cache-size)))
|
|
|
+ (progn
|
|
|
+ (setq modified-tic 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.
|
|
@@ -7403,7 +7422,7 @@ the cache."
|
|
|
(< (org-element-property :begin data) to-pos))
|
|
|
;; Calculate where next possible element
|
|
|
;; starts and update START if needed.
|
|
|
- (setq start (next-element-start data))
|
|
|
+ (setq start (next-element-start))
|
|
|
(goto-char start)
|
|
|
;; Move START further if possible.
|
|
|
(when (and next-element-re
|
|
@@ -7424,7 +7443,8 @@ the cache."
|
|
|
;;
|
|
|
;; Call FUNC. FUNC may move point.
|
|
|
(if org-element--cache-map-statistics
|
|
|
- (let ((before-time (float-time)))
|
|
|
+ (progn
|
|
|
+ (setq before-time (float-time))
|
|
|
(push (funcall func data) result)
|
|
|
(cl-incf predicate-time
|
|
|
(- (float-time)
|
|
@@ -7448,7 +7468,7 @@ the cache."
|
|
|
;; advance but simply loop to the next cache
|
|
|
;; element.
|
|
|
(when (and (cache-gapless-p)
|
|
|
- (eq (next-element-start data)
|
|
|
+ (eq (next-element-start)
|
|
|
start))
|
|
|
(setq start nil))
|
|
|
;; Check if the buffer has been modified.
|
|
@@ -7469,8 +7489,9 @@ the cache."
|
|
|
;; element past already processed
|
|
|
;; place.
|
|
|
(when (<= start (org-element-property :begin data))
|
|
|
- (goto-char start)
|
|
|
- (goto-char (next-element-start (element-match-at-point)))
|
|
|
+ (goto-char start)
|
|
|
+ (setq data (element-match-at-point))
|
|
|
+ (goto-char (next-element-start))
|
|
|
(move-start-to-next-match next-element-re))
|
|
|
(org-element-at-point to-pos)
|
|
|
(cache-walk-restart))
|
|
@@ -7513,7 +7534,7 @@ the cache."
|
|
|
(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. Time running predicates: %f sec (%f sec avg)
|
|
|
+ (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
|
|
@@ -7522,11 +7543,7 @@ the cache."
|
|
|
(- (float-time) time)
|
|
|
pre-process-time
|
|
|
predicate-time
|
|
|
- (if (zerop (+ count-predicate-calls-match
|
|
|
- count-predicate-calls-fail))
|
|
|
- 0
|
|
|
- (/ predicate-time (+ count-predicate-calls-match
|
|
|
- count-predicate-calls-fail)))
|
|
|
+ re-search-time
|
|
|
granularity restrict-elements next-re fail-re from-pos to-pos limit-count after-element))
|
|
|
;; Return result.
|
|
|
(nreverse result)))))))
|