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

Merge branch 'bugfix'

This commit is contained in:
Ihor Radchenko 2023-02-01 00:21:06 +03:00
parent 0d01a198bc 32b64607ad
commit b363ec04a2
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
2 changed files with 36 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
lisp/org-element.el
View File

@ -7411,14 +7411,16 @@ the cache."
(org-element-at-point to-pos) (org-element-at-point to-pos)
(cl-macrolet ((cache-root (cl-macrolet ((cache-root
;; Use the most optimal version of cache available. ;; Use the most optimal version of cache available.
() `(if (memq granularity '(headline headline+inlinetask)) () `(org-with-base-buffer nil
(org-element--headline-cache-root) (if (memq granularity '(headline headline+inlinetask))
(org-element--cache-root))) (org-element--headline-cache-root)
(org-element--cache-root))))
(cache-size (cache-size
;; Use the most optimal version of cache available. ;; Use the most optimal version of cache available.
() `(if (memq granularity '(headline headline+inlinetask)) () `(org-with-base-buffer nil
org-element--headline-cache-size (if (memq granularity '(headline headline+inlinetask))
org-element--cache-size)) org-element--headline-cache-size
org-element--cache-size)))
(cache-walk-restart (cache-walk-restart
;; Restart tree traversal after AVL tree re-balance. ;; Restart tree traversal after AVL tree re-balance.
() `(when node () `(when node
@ -7448,8 +7450,9 @@ the cache."
;; Avoid extra staff like timer cancels et al ;; Avoid extra staff like timer cancels et al
;; and only call `org-element--cache-sync-requests' when ;; and only call `org-element--cache-sync-requests' when
;; there are pending requests. ;; there are pending requests.
(when org-element--cache-sync-requests (org-with-base-buffer nil
(org-element--cache-sync (current-buffer))) (when org-element--cache-sync-requests
(org-element--cache-sync (current-buffer))))
;; Call `org-element--parse-to' directly avoiding any ;; Call `org-element--parse-to' directly avoiding any
;; kind of `org-element-at-point' overheads. ;; kind of `org-element-at-point' overheads.
(if restrict-elements (if restrict-elements
@ -7520,8 +7523,9 @@ the cache."
tmpnext-start)) tmpnext-start))
;; Check if cache does not have gaps. ;; Check if cache does not have gaps.
(cache-gapless-p (cache-gapless-p
() `(eq org-element--cache-change-tic () `(org-with-base-buffer nil
(alist-get granularity org-element--cache-gapless)))) (eq org-element--cache-change-tic
(alist-get granularity org-element--cache-gapless)))))
;; The core algorithm is simple walk along binary tree. However, ;; The core algorithm is simple walk along binary tree. However,
;; instead of checking all the tree elements from first to last ;; instead of checking all the tree elements from first to last
;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping ;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping
@ -7649,7 +7653,9 @@ the cache."
;; In the process, we may alter the buffer, ;; In the process, we may alter the buffer,
;; so also keep track of the cache state. ;; so also keep track of the cache state.
(progn (progn
(setq modified-tic org-element--cache-change-tic) (setq modified-tic
(org-with-base-buffer nil
org-element--cache-change-tic))
(setq cache-size (cache-size)) (setq cache-size (cache-size))
;; When NEXT-RE/FAIL-RE is provided, skip to ;; When NEXT-RE/FAIL-RE is provided, skip to
;; next regexp match after :begin of the current ;; next regexp match after :begin of the current
@ -7683,7 +7689,7 @@ the cache."
;; ;;
;; Call FUNC. FUNC may move point. ;; Call FUNC. FUNC may move point.
(setq org-element-cache-map-continue-from nil) (setq org-element-cache-map-continue-from nil)
(if org-element--cache-map-statistics (if (org-with-base-buffer nil org-element--cache-map-statistics)
(progn (progn
(setq before-time (float-time)) (setq before-time (float-time))
(push (funcall func data) result) (push (funcall func data) result)
@ -7723,8 +7729,9 @@ the cache."
start)) start))
(setq start nil)) (setq start nil))
;; Check if the buffer has been modified. ;; Check if the buffer has been modified.
(unless (and (eq modified-tic org-element--cache-change-tic) (unless (org-with-base-buffer nil
(eq cache-size (cache-size))) (and (eq modified-tic org-element--cache-change-tic)
(eq cache-size (cache-size))))
;; START may no longer be valid, update ;; START may no longer be valid, update
;; it to beginning of real element. ;; it to beginning of real element.
;; Upon modification, START may lay ;; Upon modification, START may lay

16
testing/lisp/test-org.el
View File

@ -2741,6 +2741,7 @@ SCHEDULED: <2014-03-04 tue.>"
(org-element-property (org-element-property
:begin (org-element-at-point)))))) :begin (org-element-at-point))))))
(buffer-string)))) (buffer-string))))
;; Move point.
(should (should
(= 1 (= 1
(org-test-with-temp-text "* H1\n** H1.1\n** H1.2\n" (org-test-with-temp-text "* H1\n** H1.1\n** H1.2\n"
@ -2760,7 +2761,20 @@ SCHEDULED: <2014-03-04 tue.>"
(push (org-element-property :title (org-element-at-point)) acc) (push (org-element-property :title (org-element-at-point)) acc)
(setq org-map-continue-from (setq org-map-continue-from
(line-end-position 2)))) (line-end-position 2))))
(length acc)))))) (length acc)))))
;; Modifications inside indirect buffer.
(should
(= 3
(org-test-with-temp-text "<point>* H1\n** H1.1\n** H1.2\n"
(with-current-buffer (org-get-indirect-buffer)
(let ((acc 0))
(org-map-entries
(lambda ()
(cl-incf acc)
(beginning-of-line 2)
(insert "test\n")
(beginning-of-line -1)))
acc))))))
(ert-deftest test-org/edit-headline () (ert-deftest test-org/edit-headline ()
"Test `org-edit-headline' specifications." "Test `org-edit-headline' specifications."