* [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
@ 2021-09-19 7:30 Ihor Radchenko
2021-09-19 9:58 ` Timothy
0 siblings, 1 reply; 12+ messages in thread
From: Ihor Radchenko @ 2021-09-19 7:30 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 4109 bytes --]
Hi Org,
I would like to propose adding support of storing headlines in
org-element-cache.
Currently, org-element-cache only stores elements within individual
sections. Storing headlines in cache would open various possibilities to
improve Org performance: tag inheritance, property inheritance, category
queries, id lookup, refile targets, agenda views, etc could all make use
of cache.
I am not proposing a mere idea, but have an actual working (WIP) code
in: https://github.com/yantar92/org. Also, I am attaching a reference
patch for org-element.el (the actual branch contains more changes).
Some preliminary benchmarks:
1. Complex agenda
- with cache: 12.165218664 sec
- without cache: 16.703388763 sec
2. Tangling org file with many (570) code blocks:
- with cache: 2.886041933 sec
- without cache: 6.093907514 sec
3. Archiving heading from a huge org file with many categories
- with cache: 0.6030461106 sec
- without cache: 1.0111324396 sec
4. Complex search query in a huge org file:
- with cache (via org-element-cache-map): 0.41087909697 sec
- without cache (via org-ql): 1.07440562674 sec
TBD. org-id lookups and org-refile-cache
-----
Moreover, the cache can persist across Emacs sessions, so we do not need
to care about initial cache population. See
org-element-cache-persistent and org-element-cache-path.
-----
The current state of the branch is satisfactory and I am able to use it
daily in my own system. However, the cache code is notoriously difficult
to debug. The original cache implementation has several bugs to start
with. While fixing those, I kept seeing more bugs for a very long time.
I am not yet sure that the new code is completely bug-free, though I do
not see issues anymore in my setup.
----
If there is any interest in merging this work to Org, I will need the
community help to catch any leftover bugs. The cache is now supplied
with self-consistency checks that can catch errors and report backtrace.
The self-consistency checks are enabled by default for now. Any issues
will be reported as Emacs warnings. See org-element--cache-self-verify,
org-element--cache-self-verify-frequency,
org-element--cache-diagnostics-level, and
org-element--cache-diagnostics-ring-size for details.
----
Note that self-consistency checks do slow down the cache. Setting
org-element--cache-self-verify to nil will showcase the true
performance. However, I am not confident enough in the code to disable
self-checks by default.
-----
Also, I have made several changes to org parser and org API in order to
make cache more useful. If there are any objections to the changes, I
would like to hear them.
-----
1. I introduced a new element: org-data. In a way, org-data is already
used as a placeholder element in org-element-parse-buffer. I extended
the idea further and made org-data contain actual properties. Similar
to headline elements, org-data contains property list with contents
of the top property drawer. Also, category parser not lives inside
org-element, unlike original implementation from org.el that had
little interaction with org-element API.
2. I added new standard properties to Org elements: :robust-begin,
:robust-end, :cached, :mode, :org-element--cache-sync-key, and
:granularity. They greatly reduced complexity of cache
implementation.
3. headline/org-data properties are now aware about accumulated property
values (PROPERTY/PROPERTY+ style). PROPERTY+ lines of the property
drawers are now all merged into :PROPERTY headline/org-data element
property.
4. org-element-at-point is now guaranteed to return the correct :parent
property all the way up to org-data. org-element-at-point now accepts
an extra argument preventing it from synchronising the cache.
5. New function: org-element-at-point-no-context. It behaves similar to
old org-element-at-point - :parent properties are not guaranteed to
be correct.
6. New function: org-element-cache-map. It is similar to
org-element-map, but operates on cache.
Looking forward for the feedback.
Best,
Ihor
[-- Attachment #2: org-cache-new-org-element.patch --]
[-- Type: text/x-diff, Size: 147302 bytes --]
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 2dfbaea24..f1bc80810 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -59,9 +59,11 @@ ;;; Commentary:
;;; Code:
(require 'avl-tree)
+(require 'ring)
(require 'cl-lib)
(require 'ol)
(require 'org)
+(require 'org-id)
(require 'org-compat)
(require 'org-entities)
(require 'org-footnote)
@@ -245,7 +247,7 @@ (defconst org-element-all-elements
(defconst org-element-greater-elements
'(center-block drawer dynamic-block footnote-definition headline inlinetask
item plain-list property-drawer quote-block section
- special-block table)
+ special-block table org-data)
"List of recursive element types aka Greater Elements.")
(defconst org-element-all-objects
@@ -473,7 +475,14 @@ (defsubst org-element-type (element)
((not (consp element)) (and (stringp element) 'plain-text))
((symbolp (car element)) (car element))))
-(defsubst org-element-property (property element)
+(defsubst org-element-put-property (element property value)
+ "In ELEMENT set PROPERTY to VALUE.
+Return modified element."
+ (if (stringp element) (org-add-props element nil property value)
+ (setcar (cdr element) (plist-put (nth 1 element) property value))
+ element))
+
+(defun org-element-property (property element)
"Extract the value from the PROPERTY of an ELEMENT."
(if (stringp element) (get-text-property 0 property element)
(plist-get (nth 1 element) property)))
@@ -491,13 +500,6 @@ (defsubst org-element-restriction (element)
(cdr (assq (if (symbolp element) element (org-element-type element))
org-element-object-restrictions)))
-(defsubst org-element-put-property (element property value)
- "In ELEMENT set PROPERTY to VALUE.
-Return modified element."
- (if (stringp element) (org-add-props element nil property value)
- (setcar (cdr element) (plist-put (nth 1 element) property value))
- element))
-
(defsubst org-element-set-contents (element &rest contents)
"Set ELEMENT's contents to CONTENTS.
Return ELEMENT."
@@ -612,11 +614,18 @@ (defun org-element-insert-before (element location)
;; Set appropriate :parent property.
(org-element-put-property element :parent parent)))
+(defconst org-element--cache-element-properties '(:cached
+ :org-element--cache-sync-key)
+ "List of element properties used internally by cache.")
+
(defun org-element-set-element (old new)
"Replace element or object OLD with element or object NEW.
The function takes care of setting `:parent' property for NEW."
;; Ensure OLD and NEW have the same parent.
(org-element-put-property new :parent (org-element-property :parent old))
+ (dolist (p org-element--cache-element-properties)
+ (when (org-element-property p old)
+ (org-element-put-property new p (org-element-property p old))))
(if (or (memq (org-element-type old) '(plain-text nil))
(memq (org-element-type new) '(plain-text nil)))
;; We cannot replace OLD with NEW since one of them is not an
@@ -944,24 +953,34 @@ (defun org-element-footnote-definition-interpreter (footnote-definition contents
(if (= pre-blank 0) (concat " " (org-trim contents))
(concat (make-string pre-blank ?\n) contents)))))
-
;;;; Headline
-(defun org-element--get-node-properties ()
+(defun org-element--get-node-properties (&optional at-point-p?)
"Return node properties associated to headline at point.
Upcase property names. It avoids confusion between properties
obtained through property drawer and default properties from the
parser (e.g. `:end' and :END:). Return value is a plist."
(save-excursion
- (forward-line)
- (when (looking-at-p org-planning-line-re) (forward-line))
+ (unless at-point-p?
+ (forward-line)
+ (when (looking-at-p org-planning-line-re) (forward-line)))
(when (looking-at org-property-drawer-re)
(forward-line)
(let ((end (match-end 0)) properties)
(while (< (line-end-position) end)
(looking-at org-property-re)
- (push (match-string-no-properties 3) properties)
- (push (intern (concat ":" (upcase (match-string 2)))) properties)
+ (let* ((property-name (concat ":" (upcase (match-string 2))))
+ (property-name-symbol (intern property-name))
+ (property-value (match-string-no-properties 3)))
+ (cond
+ ((and (plist-member properties property-name-symbol)
+ (string-match-p "+$" property-name))
+ (let ((val (plist-get properties property-name-symbol)))
+ (if (listp val)
+ (setf (plist-get properties property-name-symbol)
+ (append (plist-get properties property-name-symbol) (list property-value)))
+ (plist-put properties property-name-symbol (list val property-value)))))
+ (t (setq properties (plist-put properties property-name-symbol property-value)))))
(forward-line))
properties))))
@@ -983,7 +1002,7 @@ (defun org-element--get-time-properties ()
(t (setq plist (plist-put plist :closed time))))))
plist))))
-(defun org-element-headline-parser (limit &optional raw-secondary-p)
+(defun org-element-headline-parser (&optional _ raw-secondary-p)
"Parse a headline.
Return a list whose CAR is `headline' and CDR is a plist
@@ -998,8 +1017,6 @@ (defun org-element-headline-parser (limit &optional raw-secondary-p)
with its name in upper cases and colons added at the
beginning (e.g., `:CUSTOM_ID').
-LIMIT is a buffer position bounding the search.
-
When RAW-SECONDARY-P is non-nil, headline's title will not be
parsed as a secondary string, but as a plain string instead.
@@ -1021,7 +1038,10 @@ (defun org-element-headline-parser (limit &optional raw-secondary-p)
(commentedp
(and (let (case-fold-search) (looking-at org-comment-string))
(goto-char (match-end 0))))
- (title-start (point))
+ (title-start (prog1 (point)
+ (unless (or todo priority commentedp)
+ ;; Headline like "* :tag:"
+ (skip-syntax-backward " \t"))))
(tags (when (re-search-forward
"[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(line-end-position)
@@ -1036,7 +1056,17 @@ (defun org-element-headline-parser (limit &optional raw-secondary-p)
(string= org-footnote-section raw-value)))
(standard-props (org-element--get-node-properties))
(time-props (org-element--get-time-properties))
- (end (min (save-excursion (org-end-of-subtree t t)) limit))
+ (end (save-excursion
+ ;; Make sure that `org-end-of-subtree' does not try
+ ;; to use cache. The headline parser might be
+ ;; called in the midst of cache processing.
+ ;; FIXME: We cannot simply bind `org-element-use-cache' here
+ ;; because apparently some magic related to lexical
+ ;; scoping prevents `org-element--cache-active-p' call inside
+ ;; `org-end-of-subtree' to use the overridden value
+ ;; of `org-element-use-cache'.
+ (cl-letf (((symbol-function #'org-element--cache-active-p) (lambda () nil)))
+ (org-end-of-subtree t t))))
(contents-begin (save-excursion
(forward-line)
(skip-chars-forward " \r\t\n" end)
@@ -1044,7 +1074,24 @@ (defun org-element-headline-parser (limit &optional raw-secondary-p)
(contents-end (and contents-begin
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
- (line-beginning-position 2)))))
+ (line-beginning-position 2))))
+ (robust-begin (and contents-begin
+ (progn (goto-char contents-begin)
+ (when (looking-at-p org-planning-line-re)
+ (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0)))
+ ;; If there is :pre-blank, we
+ ;; need to be careful about
+ ;; robust beginning.
+ (max (if (< (+ 2 contents-begin) contents-end)
+ (+ 2 contents-begin)
+ 0)
+ (point)))))
+ (robust-end (and robust-begin
+ (when (> (- contents-end 2) robust-begin)
+ (- contents-end 2)))))
+ (unless robust-end (setq robust-begin nil))
(let ((headline
(list 'headline
(nconc
@@ -1056,6 +1103,8 @@ (defun org-element-headline-parser (limit &optional raw-secondary-p)
(1- (count-lines begin contents-begin)))
:contents-begin contents-begin
:contents-end contents-end
+ :robust-begin robust-begin
+ :robust-end robust-end
:level level
:priority priority
:tags tags
@@ -1128,6 +1177,79 @@ (defun org-element-headline-interpreter (headline contents)
(make-string (1+ pre-blank) ?\n)
contents)))
+;;;; org-data
+
+(defun org-element--get-global-node-properties ()
+ "Return node properties associated with the whole Org buffer.
+Upcase property names. It avoids confusion between properties
+obtained through property drawer and default properties from the
+parser (e.g. `:end' and :END:). Return value is a plist."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (and (org-at-comment-p) (bolp)) (forward-line))
+ (org-element--get-node-properties t)))
+
+(defun org-element-org-data-parser (&optional _)
+ "Parse org-data."
+ (org-with-wide-buffer
+ (let* ((begin 1)
+ (contents-begin (progn
+ (goto-char 1)
+ (org-skip-whitespace)
+ (beginning-of-line)
+ (point)))
+ (end (point-max))
+ (pos-before-blank (progn (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ (robust-end (when (> (- pos-before-blank 2) contents-begin)
+ (- pos-before-blank 2)))
+ (robust-begin (when (and robust-end
+ (< (+ 2 contents-begin) pos-before-blank))
+ (or
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (and (org-at-comment-p) (bolp)) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0))
+ (skip-chars-backward " \t")
+ (min robust-end (point))))
+ (+ 2 contents-begin))))
+ (category (cond ((null org-category)
+ (when buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))))
+ ((symbolp org-category) (symbol-name org-category))
+ (t org-category)))
+ (category (catch 'buffer-category
+ (org-with-point-at end
+ (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
+ (let ((element (org-element-at-point-no-context)))
+ (when (eq (org-element-type element) 'keyword)
+ (throw 'buffer-category
+ (org-element-property :value element))))))
+ category))
+ (properties (org-element--get-global-node-properties)))
+ (unless (plist-get properties :CATEGORY)
+ (setq properties (plist-put properties :CATEGORY category)))
+ (list 'org-data
+ (nconc
+ (list :begin begin
+ :contents-begin contents-begin
+ :contents-end pos-before-blank
+ :end end
+ :robust-begin robust-begin
+ :robust-end robust-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated begin
+ :path (buffer-file-name)
+ :mode 'org-data)
+ properties)))))
+
+(defun org-element-org-data-interpreter (_ contents)
+ "Interpret ORG-DATA element as Org syntax.
+CONTENTS is the contents of the element."
+ contents)
;;;; Inlinetask
@@ -1283,69 +1405,69 @@ (defun org-element-item-parser (_ struct &optional raw-secondary-p)
Assume point is at the beginning of the item."
(save-excursion
(beginning-of-line)
- (looking-at org-list-full-item-re)
- (let* ((begin (point))
- (bullet (match-string-no-properties 1))
- (checkbox (let ((box (match-string 3)))
- (cond ((equal "[ ]" box) 'off)
- ((equal "[X]" box) 'on)
- ((equal "[-]" box) 'trans))))
- (counter (let ((c (match-string 2)))
- (save-match-data
- (cond
- ((not c) nil)
- ((string-match "[A-Za-z]" c)
- (- (string-to-char (upcase (match-string 0 c)))
- 64))
- ((string-match "[0-9]+" c)
- (string-to-number (match-string 0 c)))))))
- (end (progn (goto-char (nth 6 (assq (point) struct)))
- (if (bolp) (point) (line-beginning-position 2))))
- (pre-blank 0)
- (contents-begin
- (progn
- (goto-char
- ;; Ignore tags in un-ordered lists: they are just
- ;; a part of item's body.
- (if (and (match-beginning 4)
- (save-match-data (string-match "[.)]" bullet)))
- (match-beginning 4)
- (match-end 0)))
- (skip-chars-forward " \r\t\n" end)
- (cond ((= (point) end) nil)
- ;; If first line isn't empty, contents really
- ;; start at the text after item's meta-data.
- ((= (line-beginning-position) begin) (point))
- (t
- (setq pre-blank
- (count-lines (line-beginning-position) begin))
- (line-beginning-position)))))
- (contents-end (and contents-begin
- (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
- (item
- (list 'item
- (list :bullet bullet
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :checkbox checkbox
- :counter counter
- :structure struct
- :pre-blank pre-blank
- :post-blank (count-lines (or contents-end begin) end)
- :post-affiliated begin))))
- (org-element-put-property
- item :tag
- (let ((raw (org-list-get-tag begin struct)))
- (when raw
- (if raw-secondary-p raw
- (org-element--parse-objects
- (match-beginning 4) (match-end 4) nil
- (org-element-restriction 'item)
- item))))))))
+ (when (looking-at org-list-full-item-re)
+ (let* ((begin (point))
+ (bullet (match-string-no-properties 1))
+ (checkbox (let ((box (match-string 3)))
+ (cond ((equal "[ ]" box) 'off)
+ ((equal "[X]" box) 'on)
+ ((equal "[-]" box) 'trans))))
+ (counter (let ((c (match-string 2)))
+ (save-match-data
+ (cond
+ ((not c) nil)
+ ((string-match "[A-Za-z]" c)
+ (- (string-to-char (upcase (match-string 0 c)))
+ 64))
+ ((string-match "[0-9]+" c)
+ (string-to-number (match-string 0 c)))))))
+ (end (progn (goto-char (nth 6 (assq (point) struct)))
+ (if (bolp) (point) (line-beginning-position 2))))
+ (pre-blank 0)
+ (contents-begin
+ (progn
+ (goto-char
+ ;; Ignore tags in un-ordered lists: they are just
+ ;; a part of item's body.
+ (if (and (match-beginning 4)
+ (save-match-data (string-match "[.)]" bullet)))
+ (match-beginning 4)
+ (match-end 0)))
+ (skip-chars-forward " \r\t\n" end)
+ (cond ((= (point) end) nil)
+ ;; If first line isn't empty, contents really
+ ;; start at the text after item's meta-data.
+ ((= (line-beginning-position) begin) (point))
+ (t
+ (setq pre-blank
+ (count-lines (line-beginning-position) begin))
+ (line-beginning-position)))))
+ (contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
+ (item
+ (list 'item
+ (list :bullet bullet
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :checkbox checkbox
+ :counter counter
+ :structure struct
+ :pre-blank pre-blank
+ :post-blank (count-lines (or contents-end begin) end)
+ :post-affiliated begin))))
+ (org-element-put-property
+ item :tag
+ (let ((raw (org-list-get-tag begin struct)))
+ (when raw
+ (if raw-secondary-p raw
+ (org-element--parse-objects
+ (match-beginning 4) (match-end 4) nil
+ (org-element-restriction 'item)
+ item)))))))))
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
@@ -1397,7 +1519,12 @@ (defun org-element--list-struct (limit)
(let ((case-fold-search t)
(top-ind limit)
(item-re (org-item-re))
- (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
+ (inlinetask-re (and (featurep 'org-inlinetask)
+ (boundp 'org-inlinetask-min-level)
+ (boundp 'org-inlinetask-max-level)
+ (format "^\\*\\{%d,%d\\}+ "
+ org-inlinetask-min-level
+ org-inlinetask-max-level)))
items struct)
(save-excursion
(catch :exit
@@ -1622,16 +1749,22 @@ (defun org-element-section-parser (_)
(save-excursion
;; Beginning of section is the beginning of the first non-blank
;; line after previous headline.
- (let ((begin (point))
- (end (progn (org-with-limited-levels (outline-next-heading))
- (point)))
- (pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
+ (let* ((begin (point))
+ (end (progn (org-with-limited-levels (outline-next-heading))
+ (point)))
+ (pos-before-blank (progn (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ (robust-end (when (> (- pos-before-blank 2) begin)
+ (- pos-before-blank 2)))
+ (robust-begin (when robust-end begin))
+ )
(list 'section
(list :begin begin
:end end
:contents-begin begin
:contents-end pos-before-blank
+ :robust-begin robust-begin
+ :robust-end robust-end
:post-blank (count-lines pos-before-blank end)
:post-affiliated begin)))))
@@ -3958,7 +4091,7 @@ ;;; Parsing Element Starting At Point
;; It returns the Lisp representation of the element starting at
;; point.
-(defun org-element--current-element (limit &optional granularity mode structure)
+(defun org-element--current-element (limit &optional granularity mode structure add-to-cache)
"Parse the element starting at point.
Return value is a list like (TYPE PROPS) where TYPE is the type
@@ -3983,157 +4116,196 @@ (defun org-element--current-element (limit &optional granularity mode structure)
If STRUCTURE isn't provided but MODE is set to `item', it will be
computed.
+Optional argument ADD-TO-CACHE, when non-nil, and when cache is active,
+will also add current element to cache if it is not yet there. Use
+this argument with care, as validity of the element in parse tree is
+not checked.
+
This function assumes point is always at the beginning of the
element it has to parse."
- (save-excursion
- (let ((case-fold-search t)
- ;; Determine if parsing depth allows for secondary strings
- ;; parsing. It only applies to elements referenced in
- ;; `org-element-secondary-value-alist'.
- (raw-secondary-p (and granularity (not (eq granularity 'object)))))
- (cond
- ;; Item.
- ((eq mode 'item)
- (org-element-item-parser limit structure raw-secondary-p))
- ;; Table Row.
- ((eq mode 'table-row) (org-element-table-row-parser limit))
- ;; Node Property.
- ((eq mode 'node-property) (org-element-node-property-parser limit))
- ;; Headline.
- ((org-with-limited-levels (org-at-heading-p))
- (org-element-headline-parser limit raw-secondary-p))
- ;; Sections (must be checked after headline).
- ((eq mode 'section) (org-element-section-parser limit))
- ((eq mode 'first-section)
- (org-element-section-parser
- (or (save-excursion (org-with-limited-levels (outline-next-heading)))
- limit)))
- ;; Comments.
- ((looking-at "^[ \t]*#\\(?: \\|$\\)")
- (org-element-comment-parser limit))
- ;; Planning.
- ((and (eq mode 'planning)
- (eq ?* (char-after (line-beginning-position 0)))
- (looking-at org-planning-line-re))
- (org-element-planning-parser limit))
- ;; Property drawer.
- ((and (pcase mode
- (`planning (eq ?* (char-after (line-beginning-position 0))))
- ((or `property-drawer `top-comment)
- (save-excursion
- (beginning-of-line 0)
- (not (looking-at "[[:blank:]]*$"))))
- (_ nil))
- (looking-at org-property-drawer-re))
- (org-element-property-drawer-parser limit))
- ;; When not at bol, point is at the beginning of an item or
- ;; a footnote definition: next item is always a paragraph.
- ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
- ;; Clock.
- ((looking-at org-clock-line-re) (org-element-clock-parser limit))
- ;; Inlinetask.
- ((looking-at "^\\*+ ")
- (org-element-inlinetask-parser limit raw-secondary-p))
- ;; From there, elements can have affiliated keywords.
- (t (let ((affiliated (org-element--collect-affiliated-keywords
- limit (memq granularity '(nil object)))))
- (cond
- ;; Jumping over affiliated keywords put point off-limits.
- ;; Parse them as regular keywords.
- ((and (cdr affiliated) (>= (point) limit))
- (goto-char (car affiliated))
- (org-element-keyword-parser limit nil))
- ;; LaTeX Environment.
- ((looking-at org-element--latex-begin-environment)
- (org-element-latex-environment-parser limit affiliated))
- ;; Drawer.
- ((looking-at org-drawer-regexp)
- (org-element-drawer-parser limit affiliated))
- ;; Fixed Width
- ((looking-at "[ \t]*:\\( \\|$\\)")
- (org-element-fixed-width-parser limit affiliated))
- ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
- ;; Keywords.
- ((looking-at "[ \t]*#\\+")
- (goto-char (match-end 0))
- (cond
- ((looking-at "BEGIN_\\(\\S-+\\)")
- (beginning-of-line)
- (funcall (pcase (upcase (match-string 1))
- ("CENTER" #'org-element-center-block-parser)
- ("COMMENT" #'org-element-comment-block-parser)
- ("EXAMPLE" #'org-element-example-block-parser)
- ("EXPORT" #'org-element-export-block-parser)
- ("QUOTE" #'org-element-quote-block-parser)
- ("SRC" #'org-element-src-block-parser)
- ("VERSE" #'org-element-verse-block-parser)
- (_ #'org-element-special-block-parser))
- limit
- affiliated))
- ((looking-at "CALL:")
- (beginning-of-line)
- (org-element-babel-call-parser limit affiliated))
- ((looking-at "BEGIN:? ")
- (beginning-of-line)
- (org-element-dynamic-block-parser limit affiliated))
- ((looking-at "\\S-+:")
- (beginning-of-line)
- (org-element-keyword-parser limit affiliated))
- (t
- (beginning-of-line)
- (org-element-paragraph-parser limit affiliated))))
- ;; Footnote Definition.
- ((looking-at org-footnote-definition-re)
- (org-element-footnote-definition-parser limit affiliated))
- ;; Horizontal Rule.
- ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
- (org-element-horizontal-rule-parser limit affiliated))
- ;; Diary Sexp.
- ((looking-at "%%(")
- (org-element-diary-sexp-parser limit affiliated))
- ;; Table.
- ((or (looking-at "[ \t]*|")
- ;; There is no strict definition of a table.el
- ;; table. Try to prevent false positive while being
- ;; quick.
- (let ((rule-regexp
- (rx (zero-or-more (any " \t"))
- "+"
- (one-or-more (one-or-more "-") "+")
- (zero-or-more (any " \t"))
- eol))
- (non-table.el-line
- (rx bol
- (zero-or-more (any " \t"))
- (or eol (not (any "+| \t")))))
- (next (line-beginning-position 2)))
- ;; Start with a full rule.
- (and
- (looking-at rule-regexp)
- (< next limit) ;no room for a table.el table
- (save-excursion
- (end-of-line)
- (cond
- ;; Must end with a full rule.
- ((not (re-search-forward non-table.el-line limit 'move))
- (if (bolp) (forward-line -1) (beginning-of-line))
- (looking-at rule-regexp))
- ;; Ignore pseudo-tables with a single
- ;; rule.
- ((= next (line-beginning-position))
- nil)
- ;; Must end with a full rule.
- (t
- (forward-line -1)
- (looking-at rule-regexp)))))))
- (org-element-table-parser limit affiliated))
- ;; List.
- ((looking-at (org-item-re))
- (org-element-plain-list-parser
- limit affiliated
- (or structure (org-element--list-struct limit))))
- ;; Default element: Paragraph.
- (t (org-element-paragraph-parser limit affiliated)))))))))
+ (if-let* ((element (and (not (buffer-narrowed-p))
+ (org-element--cache-active-p)
+ (not org-element--cache-sync-requests)
+ (org-element--cache-find (point) t)))
+ (element (progn (while (and element
+ (not (and (eq (point) (org-element-property :begin element))
+ (eq mode (org-element-property :mode element)))))
+ (setq element (org-element-property :parent element)))
+ element))
+ (old-element element)
+ (element (when
+ (pcase (org-element-property :granularity element)
+ (`nil t)
+ (`object t)
+ (`element (not (memq granularity '(nil object))))
+ (`greater-element (not (memq granularity '(nil object element))))
+ (`headline (eq granularity 'headline)))
+ element)))
+ element
+ (save-excursion
+ (let ((case-fold-search t)
+ ;; Determine if parsing depth allows for secondary strings
+ ;; parsing. It only applies to elements referenced in
+ ;; `org-element-secondary-value-alist'.
+ (raw-secondary-p (and granularity (not (eq granularity 'object))))
+ result)
+ (setq
+ result
+ (cond
+ ;; Item.
+ ((eq mode 'item)
+ (org-element-item-parser limit structure raw-secondary-p))
+ ;; Table Row.
+ ((eq mode 'table-row) (org-element-table-row-parser limit))
+ ;; Node Property.
+ ((eq mode 'node-property) (org-element-node-property-parser limit))
+ ;; Headline.
+ ((org-with-limited-levels (org-at-heading-p))
+ (org-element-headline-parser limit raw-secondary-p))
+ ;; Sections (must be checked after headline).
+ ((eq mode 'section) (org-element-section-parser limit))
+ ((eq mode 'first-section)
+ (org-element-section-parser
+ (or (save-excursion (org-with-limited-levels (outline-next-heading)))
+ limit)))
+ ;; Comments.
+ ((looking-at "^[ \t]*#\\(?: \\|$\\)")
+ (org-element-comment-parser limit))
+ ;; Planning.
+ ((and (eq mode 'planning)
+ (eq ?* (char-after (line-beginning-position 0)))
+ (looking-at org-planning-line-re))
+ (org-element-planning-parser limit))
+ ;; Property drawer.
+ ((and (pcase mode
+ (`planning (eq ?* (char-after (line-beginning-position 0))))
+ ((or `property-drawer `top-comment)
+ (save-excursion
+ (beginning-of-line 0)
+ (not (looking-at "[[:blank:]]*$"))))
+ (_ nil))
+ (looking-at org-property-drawer-re))
+ (org-element-property-drawer-parser limit))
+ ;; When not at bol, point is at the beginning of an item or
+ ;; a footnote definition: next item is always a paragraph.
+ ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
+ ;; Clock.
+ ((looking-at org-clock-line-re) (org-element-clock-parser limit))
+ ;; Inlinetask.
+ ((looking-at "^\\*+ ")
+ (org-element-inlinetask-parser limit raw-secondary-p))
+ ;; From there, elements can have affiliated keywords.
+ (t (let ((affiliated (org-element--collect-affiliated-keywords
+ limit (memq granularity '(nil object)))))
+ (cond
+ ;; Jumping over affiliated keywords put point off-limits.
+ ;; Parse them as regular keywords.
+ ((and (cdr affiliated) (>= (point) limit))
+ (goto-char (car affiliated))
+ (org-element-keyword-parser limit nil))
+ ;; LaTeX Environment.
+ ((looking-at org-element--latex-begin-environment)
+ (org-element-latex-environment-parser limit affiliated))
+ ;; Drawer.
+ ((looking-at org-drawer-regexp)
+ (org-element-drawer-parser limit affiliated))
+ ;; Fixed Width
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (org-element-fixed-width-parser limit affiliated))
+ ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
+ ;; Keywords.
+ ((looking-at "[ \t]*#\\+")
+ (goto-char (match-end 0))
+ (cond
+ ((looking-at "BEGIN_\\(\\S-+\\)")
+ (beginning-of-line)
+ (funcall (pcase (upcase (match-string 1))
+ ("CENTER" #'org-element-center-block-parser)
+ ("COMMENT" #'org-element-comment-block-parser)
+ ("EXAMPLE" #'org-element-example-block-parser)
+ ("EXPORT" #'org-element-export-block-parser)
+ ("QUOTE" #'org-element-quote-block-parser)
+ ("SRC" #'org-element-src-block-parser)
+ ("VERSE" #'org-element-verse-block-parser)
+ (_ #'org-element-special-block-parser))
+ limit
+ affiliated))
+ ((looking-at "CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit affiliated))
+ ((looking-at "BEGIN:? ")
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit affiliated))
+ ((looking-at "\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit affiliated))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit affiliated))))
+ ;; Footnote Definition.
+ ((looking-at org-footnote-definition-re)
+ (org-element-footnote-definition-parser limit affiliated))
+ ;; Horizontal Rule.
+ ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
+ (org-element-horizontal-rule-parser limit affiliated))
+ ;; Diary Sexp.
+ ((looking-at "%%(")
+ (org-element-diary-sexp-parser limit affiliated))
+ ;; Table.
+ ((or (looking-at "[ \t]*|")
+ ;; There is no strict definition of a table.el
+ ;; table. Try to prevent false positive while being
+ ;; quick.
+ (let ((rule-regexp
+ (rx (zero-or-more (any " \t"))
+ "+"
+ (one-or-more (one-or-more "-") "+")
+ (zero-or-more (any " \t"))
+ eol))
+ (non-table.el-line
+ (rx bol
+ (zero-or-more (any " \t"))
+ (or eol (not (any "+| \t")))))
+ (next (line-beginning-position 2)))
+ ;; Start with a full rule.
+ (and
+ (looking-at rule-regexp)
+ (< next limit) ;no room for a table.el table
+ (save-excursion
+ (end-of-line)
+ (cond
+ ;; Must end with a full rule.
+ ((not (re-search-forward non-table.el-line limit 'move))
+ (if (bolp) (forward-line -1) (beginning-of-line))
+ (looking-at rule-regexp))
+ ;; Ignore pseudo-tables with a single
+ ;; rule.
+ ((= next (line-beginning-position))
+ nil)
+ ;; Must end with a full rule.
+ (t
+ (forward-line -1)
+ (looking-at rule-regexp)))))))
+ (org-element-table-parser limit affiliated))
+ ;; List.
+ ((looking-at (org-item-re))
+ (org-element-plain-list-parser
+ limit affiliated
+ (or structure (org-element--list-struct limit))))
+ ;; Default element: Paragraph.
+ (t (org-element-paragraph-parser limit affiliated)))))))
+ (when result
+ (org-element-put-property result :mode mode)
+ (org-element-put-property result :granularity granularity))
+ (when (and (not (buffer-narrowed-p))
+ (org-element--cache-active-p)
+ (not org-element--cache-sync-requests)
+ add-to-cache)
+ (if (not old-element)
+ (setq result (org-element--cache-put result))
+ (org-element-set-element old-element result)
+ (setq result old-element)))
+ result))))
;; Most elements can have affiliated keywords. When looking for an
@@ -4148,6 +4320,8 @@ (defun org-element--collect-affiliated-keywords (limit parse)
CDR a plist of keywords and values and move point to the
beginning of the first line after them.
+The plist of keywords preserves their order.
+
As a special case, if element doesn't start at the beginning of
the line (e.g., a paragraph starting an item), CAR is current
position of point and CDR is nil.
@@ -4202,7 +4376,7 @@ (defun org-element--collect-affiliated-keywords (limit parse)
(when (or (member kwd org-element-multiple-keywords)
;; Attributes can always appear on multiple lines.
(string-match "^ATTR_" kwd))
- (setq value (cons value (plist-get output kwd-sym))))
+ (setq value (append (plist-get output kwd-sym) (list value))))
;; Eventually store the new value in OUTPUT.
(setq output (plist-put output kwd-sym value))
;; Move to next keyword.
@@ -4274,12 +4448,13 @@ (defun org-element-parse-buffer (&optional granularity visible-only)
This function assumes that current major mode is `org-mode'."
(save-excursion
(goto-char (point-min))
- (org-skip-whitespace)
- (org-element--parse-elements
- (point-at-bol) (point-max)
- ;; Start in `first-section' mode so text before the first
- ;; headline belongs to a section.
- 'first-section nil granularity visible-only (list 'org-data nil))))
+ (let ((org-data (org-element-org-data-parser)))
+ (org-skip-whitespace)
+ (org-element--parse-elements
+ (point-at-bol) (point-max)
+ ;; Start in `first-section' mode so text before the first
+ ;; headline belongs to a section.
+ 'first-section nil granularity visible-only org-data))))
(defun org-element-parse-secondary-string (string restriction &optional parent)
"Recursively parse objects in STRING and return structure.
@@ -4440,7 +4615,7 @@ (defun org-element-map
((not value))
((member kwd org-element-dual-keywords)
(if (member kwd org-element-multiple-keywords)
- (dolist (line (reverse value))
+ (dolist (line value)
(funcall --walk-tree (cdr line))
(funcall --walk-tree (car line)))
(funcall --walk-tree (cdr value))
@@ -4468,6 +4643,91 @@ (defun org-element-map
;; Return value in a proper order.
(nreverse --acc)))))
+(defun org-element-cache-map (granularity func)
+ "Map all elements in current buffer with FUNC according to GRANULARITY.
+
+This function is a subset of what `org-element-map' does, but much more performant.
+Cached elements are supplied as the single argument of FUNC. Changes
+to elements made in FUNC will also alter the cache.
+
+GRANULARITY can be `headline', `greater-element', or `element'.
+`object' granularity is not supported.
+
+If some elements are not yet in cache, they will be added."
+ (unless (org-element--cache-active-p)
+ (error "Cache must be active."))
+ (org-with-wide-buffer
+ ;; Synchronise cache up to the end of buffer.
+ (org-element-at-point (point-max))
+ (let ((start nil)
+ (prev nil)
+ (node (org-element--cache-root))
+ (stack (list nil))
+ (leftp t)
+ result
+ continue-flag)
+ (while node
+ (let ((data (avl-tree--node-data node)))
+ (if (and leftp (avl-tree--node-left node)
+ (or (not prev)
+ (not (org-element--cache-key-less-p
+ (org-element--cache-key data)
+ (org-element--cache-key prev)))))
+ (progn (push node stack)
+ (setq node (avl-tree--node-left node)))
+ (let ((type (org-element-type data))
+ (beg (org-element-property :begin data))
+ (end (org-element-property :end data))
+ (cbeg (org-element-property :contents-begin data)))
+ (unless (or (and start (< beg start))
+ (and prev (not (org-element--cache-key-less-p
+ (org-element--cache-key prev)
+ (org-element--cache-key data)))))
+ (if (or (not start) (= beg start))
+ (progn
+ (pcase granularity
+ (`headline
+ (when (eq type 'headline)
+ (push (funcall func data) result)
+ (unless (car result) (pop result)))
+ (setq start (or (and (memq type '(headline org-data)) cbeg)
+ end)))
+ (`greater-element
+ (when (memq type org-element-greater-elements)
+ (push (funcall func data) result)
+ (unless (car result) (pop result)))
+ (setq start (or cbeg end))
+ (let ((parent data))
+ (catch :exit
+ (while (setq parent (org-element-property :parent parent))
+ (if (eq start (org-element-property :contents-end parent))
+ (setq start (org-element-property :end parent))
+ (throw :exit t))))))
+ (`element
+ (push (funcall func data) result)
+ (unless (car result) (pop result))
+ (setq start (or cbeg end))
+ (let ((parent data))
+ (catch :exit
+ (while (setq parent (org-element-property :parent parent))
+ (if (eq start (org-element-property :contents-end parent))
+ (setq start (org-element-property :end parent))
+ (throw :exit t))))))
+ (_ (error "Unsupported granularity: %S" granularity)))
+ (setq prev data))
+ (org-element--parse-to start)
+ (setq node (org-element--cache-root)
+ stack (list nil)
+ leftp t
+ continue-flag t))))
+ (if continue-flag
+ (setq continue-flag nil)
+ (setq node (if (setq leftp (avl-tree--node-right node))
+ (avl-tree--node-right node)
+ (pop stack)))))))
+ ;; Return result.
+ (nreverse result))))
+
;; The following functions are internal parts of the parser.
;;
;; The first one, `org-element--parse-elements' acts at the element's
@@ -4494,6 +4754,8 @@ (defsubst org-element--next-mode (mode type parent?)
(pcase type
(`headline 'section)
((and (guard (eq mode 'first-section)) `section) 'top-comment)
+ ((and (guard (eq mode 'org-data)) `org-data) 'first-section)
+ ((and (guard (not mode)) `org-data) 'first-section)
(`inlinetask 'planning)
(`plain-list 'item)
(`property-drawer 'node-property)
@@ -5035,12 +5297,35 @@ ;;; Cache
;; even when the tree is only partially synchronized.
-(defvar org-element-use-cache nil
+(defvar org-element-use-cache t
"Non-nil when Org parser should cache its results.
WARNING: for the time being, using cache sometimes triggers
freezes. Therefore, it is disabled by default. Activate it if
-you want to help debugging the issue.")
+you want to help debugging the issue.
+
+UPDATE: At least part of the freezes should not happen anymore.
+Hopefully, this is finally fixed, but need more testing.")
+
+(defvar org-element-cache-persistent t
+ "Non-nil when cache should persist between Emacs sessions.")
+
+(defvar org-element-cache-path (file-name-concat user-emacs-directory "org-element-cache/")
+ "Directory where element cache is stored.")
+
+(defvar org-element-cache-index-file "index"
+ "File name used to store `org-element-cache--index'.")
+
+(defvar org-element-cache--index nil
+ "Global cache index.
+
+The index is a list of plists. Each plist contains information about
+a file cache. Each plist contains the following properties:
+
+- `:path': buffer file path
+- `:inode': buffer file inode
+- `:hash': buffer hash
+- `:cache-file': cache file name")
(defvar org-element-cache-sync-idle-time 0.6
"Length, in seconds, of idle time before syncing cache.")
@@ -5055,16 +5340,47 @@ (defvar org-element-cache-sync-break 0.3
"Duration, as a time value, of the pause between synchronizations.
See `org-element-cache-sync-duration' for more information.")
+(defvar org-element--cache-self-verify t
+ "Activate extra consistency for the cache.
+
+This will cause performance degradation.
+
+When set to symbol `backtrace', record and display backtrace log if
+any inconsistency is detected.")
+
+(defvar org-element--cache-self-verify-frequency 0.03
+ "Frequency of cache element verification.
+
+This number is a probability to check an element requested from cache
+to be correct. Setting this to a value less than 0.0001 is useless.")
+
+(defvar org-element--cache-diagnostics nil
+ "Print detailed diagnostics of cache processing.")
+
+(defvar org-element--cache-diagnostics-level 2
+ "Detail level of the diagnostics.")
+
+(defvar-local org-element--cache-diagnostics-ring nil
+ "Ring containing last `org-element--cache-diagnostics-ring-size'
+cache process log entries.")
+
+(defvar org-element--cache-diagnostics-ring-size 5000
+ "Size of `org-element--cache-diagnostics-ring'.")
;;;; Data Structure
-(defvar org-element--cache nil
+(defvar-local org-element--cache nil
"AVL tree used to cache elements.
Each node of the tree contains an element. Comparison is done
with `org-element--cache-compare'. This cache is used in
`org-element-at-point'.")
-(defvar org-element--cache-sync-requests nil
+(defvar-local org-element--cache-size 0
+ "Size of the `org-element--cache'.
+
+Storing value is variable is faster because `avl-tree-size' is O(N).")
+
+(defvar-local org-element--cache-sync-requests nil
"List of pending synchronization requests.
A request is a vector with the following pattern:
@@ -5081,7 +5397,10 @@ (defvar org-element--cache-sync-requests nil
removed, BEG and END is buffer position delimiting the
modifications. Elements starting between them (inclusive) are
removed. So are elements whose parent is removed. PARENT, when
-non-nil, is the parent of the first element to be removed.
+non-nil, is the common parent of all the elements between BEG and END.
+
+It is guaranteed that only a single phase 0 request exists at any
+moment of time. If it does, it must be the first request in the list.
During phase 1, NEXT is the key of the next known element in
cache and BEG its beginning position. Parse buffer between that
@@ -5090,18 +5409,112 @@ (defvar org-element--cache-sync-requests nil
During phase 2, NEXT is the key of the next element to shift in
the parse tree. All elements starting from this one have their
-properties relatives to buffer positions shifted by integer
+properties relative to buffer positions shifted by integer
OFFSET and, if they belong to element PARENT, are adopted by it.
-PHASE specifies the phase number, as an integer.")
+PHASE specifies the phase number, as an integer.
+
+For any synchronisation request, all the later requests in the cache
+must not start at or before END. See `org-element--cache-submit-request'.")
-(defvar org-element--cache-sync-timer nil
+(defvar-local org-element--cache-sync-timer nil
"Timer used for cache synchronization.")
-(defvar org-element--cache-sync-keys nil
- "Hash table used to store keys during synchronization.
+(defvar-local org-element--cache-sync-keys-value nil
+ "Id value used to identify keys during synchronisation.
See `org-element--cache-key' for more information.")
+(defvar-local org-element--cache-change-tic nil
+ "Last `buffer-chars-modified-tick' for registered changes.")
+
+(defvar org-element--cache-non-modifying-commands '(org-agenda
+ org-agenda-redo
+ org-sparse-tree
+ org-occur
+ org-columns
+ org-columns-redo
+ org-columns-new
+ org-columns-delete
+ org-columns-compute
+ org-columns-insert-dblock
+ org-agenda-columns
+ org-ctrl-c-ctrl-c)
+ "List of commands that are not expected to change the cache state.
+
+This variable is used to determine when re-parsing buffer is not going
+to slow down the command.
+
+If the commends end up modifying the cache, the worst case scenario is
+performance drop. So, advicing these commands is safe. Yet, it is
+better to remove the commands adviced in such way from this list.")
+
+(defmacro org-element--request-key (request)
+ "Get NEXT part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 0))
+
+(defmacro org-element--request-beg (request)
+ "Get BEG part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 1))
+
+(defmacro org-element--request-end (request)
+ "Get END part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 2))
+
+(defmacro org-element--request-offset (request)
+ "Get OFFSET part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 3))
+
+(defmacro org-element--request-parent (request)
+ "Get PARENT part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 4))
+
+(defmacro org-element--request-phase (request)
+ "Get PHASE part of a `org-element--cache-sync-requests' REQUEST."
+ `(aref ,request 5))
+
+(defmacro org-element--format-element (element)
+ "Format ELEMENT for printing in diagnostics."
+ `(let ((print-length 50)
+ (print-level 5))
+ (prin1-to-string ,element)))
+
+(cl-defmacro org-element--cache-log-message (format-string &rest args &key (level 1) &allow-other-keys)
+ "Add a new log message for org-element-cache."
+ `(when (and
+ (<= ,level org-element--cache-diagnostics-level)
+ (or org-element--cache-diagnostics
+ (eq org-element--cache-self-verify 'backtrace)))
+ (let* ((format-string (concat (format "org-element-cache diagnostics(%s): "
+ (buffer-name (current-buffer)))
+ ,format-string))
+ (format-string (funcall #'format format-string ,@args)))
+ (if org-element--cache-diagnostics
+ (warn "%s" format-string)
+ (unless org-element--cache-diagnostics-ring
+ (setq org-element--cache-diagnostics-ring
+ (make-ring org-element--cache-diagnostics-ring-size)))
+ (ring-insert org-element--cache-diagnostics-ring format-string)))))
+
+(defmacro org-element--cache-warn (format-string &rest args)
+ "Raise warning for org-element-cache."
+ `(let* ((format-string (funcall #'format ,format-string ,@args))
+ (format-string
+ (if (or (not org-element--cache-diagnostics-ring)
+ (not (eq 'backtrace org-element--cache-self-verify)))
+ format-string
+ (prog1
+ (concat (format "Warning(%s): "
+ (buffer-name (current-buffer)))
+ format-string
+ "\nBacktrace:\n "
+ (mapconcat #'identity
+ (ring-elements org-element--cache-diagnostics-ring)
+ "\n "))
+ (setq org-element--cache-diagnostics-ring nil)))))
+ (if (and (boundp 'org-batch-test) org-batch-test)
+ (error "%s" (concat "org-element--cache: " format-string))
+ (warn "%s" (concat "org-element--cache: " format-string)))))
+
(defsubst org-element--cache-key (element)
"Return a unique key for ELEMENT in cache tree.
@@ -5111,16 +5524,19 @@ (defsubst org-element--cache-key (element)
When no synchronization is taking place, a key is simply the
beginning position of the element, or that position plus one in
the case of an first item (respectively row) in
-a list (respectively a table).
+a list (respectively a table). They key of a section is its beginning
+position minus one.
During a synchronization, the key is the one the element had when
the cache was synchronized for the last time. Elements added to
cache during the synchronization get a new key generated with
`org-element--cache-generate-key'.
-Such keys are stored in `org-element--cache-sync-keys'. The hash
-table is cleared once the synchronization is complete."
- (or (gethash element org-element--cache-sync-keys)
+Such keys are stored inside the element property
+`:org-element--cache-sync-key'. The property is a cons containing
+current `org-element--cache-sync-keys-value' and the element key."
+ (or (when (eq org-element--cache-sync-keys-value (car (org-element-property :org-element--cache-sync-key element)))
+ (cdr (org-element-property :org-element--cache-sync-key element)))
(let* ((begin (org-element-property :begin element))
;; Increase beginning position of items (respectively
;; table rows) by one, so the first item can get
@@ -5128,10 +5544,19 @@ (defsubst org-element--cache-key (element)
;; table).
(key (if (memq (org-element-type element) '(item table-row))
(1+ begin)
- begin)))
- (if org-element--cache-sync-requests
- (puthash element key org-element--cache-sync-keys)
- key))))
+ ;; Decrease beginning position of sections by one,
+ ;; so that the first element of the section get
+ ;; different key from the parent section.
+ (if (eq (org-element-type element) 'section)
+ (1- begin)
+ (if (eq (org-element-type element) 'org-data)
+ (- begin 2)
+ begin)))))
+ (when org-element--cache-sync-requests
+ (org-element-put-property element
+ :org-element--cache-sync-key
+ (cons org-element--cache-sync-keys-value key)))
+ key)))
(defun org-element--cache-generate-key (lower upper)
"Generate a key between LOWER and UPPER.
@@ -5224,8 +5649,7 @@ (defsubst org-element--cache-key-less-p (a b)
(defun org-element--cache-compare (a b)
"Non-nil when element A is located before element B."
- (org-element--cache-key-less-p (org-element--cache-key a)
- (org-element--cache-key b)))
+ (org-element--cache-key-less-p (org-element--cache-key a) (org-element--cache-key b)))
(defsubst org-element--cache-root ()
"Return root value in cache.
@@ -5235,11 +5659,27 @@ (defsubst org-element--cache-root ()
;;;; Tools
-(defsubst org-element--cache-active-p ()
+(defsubst org-element--cache-active-p (&optional called-from-cache-change-func-p)
"Non-nil when cache is active in current buffer."
(and org-element-use-cache
org-element--cache
- (derived-mode-p 'org-mode)))
+ (derived-mode-p 'org-mode)
+ ;; org-num-mode calls some Org structure analysis functions
+ ;; that can trigger cache update in the middle of changes. See
+ ;; `org-num--verify' calling `org-num--skip-value' calling
+ ;; `org-entry-get' that uses cache.
+ ;; Forcefully disable cache when called from inside a
+ ;; modification hook, where `inhibit-modification-hooks' is set
+ ;; to t.
+ (or called-from-cache-change-func-p
+ (not inhibit-modification-hooks)
+ (eq org-element--cache-change-tic (buffer-chars-modified-tick)))))
+
+(defmacro org-element-with-disabled-cache (&rest body)
+ "Run BODY without active org-element-cache."
+ (declare (debug (form body)) (indent 1))
+ `(cl-letf (((symbol-function #'org-element--cache-active-p) (lambda () nil)))
+ ,@body))
(defun org-element--cache-find (pos &optional side)
"Find element in cache starting at POS or before.
@@ -5254,51 +5694,55 @@ (defun org-element--cache-find (pos &optional side)
The function can only find elements in the synchronized part of
the cache."
- (let ((limit (and org-element--cache-sync-requests
- (aref (car org-element--cache-sync-requests) 0)))
- (node (org-element--cache-root))
- lower upper)
- (while node
- (let* ((element (avl-tree--node-data node))
- (begin (org-element-property :begin element)))
- (cond
- ((and limit
- (not (org-element--cache-key-less-p
+ (with-current-buffer (or (buffer-base-buffer) (current-buffer))
+ (let ((limit (and org-element--cache-sync-requests
+ (org-element--request-key (car org-element--cache-sync-requests))))
+ (node (org-element--cache-root))
+ lower upper)
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (begin (org-element-property :begin element)))
+ (cond
+ ((and limit
+ (not (org-element--cache-key-less-p
(org-element--cache-key element) limit)))
- (setq node (avl-tree--node-left node)))
- ((> begin pos)
- (setq upper element
- node (avl-tree--node-left node)))
- ((< begin pos)
- (setq lower element
- node (avl-tree--node-right node)))
- ;; We found an element in cache starting at POS. If `side'
- ;; is `both' we also want the next one in order to generate
- ;; a key in-between.
- ;;
- ;; If the element is the first row or item in a table or
- ;; a plain list, we always return the table or the plain
- ;; list.
- ;;
- ;; In any other case, we return the element found.
- ((eq side 'both)
- (setq lower element)
- (setq node (avl-tree--node-right node)))
- ((and (memq (org-element-type element) '(item table-row))
- (let ((parent (org-element-property :parent element)))
- (and (= (org-element-property :begin element)
- (org-element-property :contents-begin parent))
- (setq node nil
- lower parent
- upper parent)))))
- (t
- (setq node nil
- lower element
- upper element)))))
- (pcase side
- (`both (cons lower upper))
- (`nil lower)
- (_ upper))))
+ (setq node (avl-tree--node-left node)))
+ ((> begin pos)
+ (setq upper element
+ node (avl-tree--node-left node)))
+ ((or (< begin pos)
+ ;; If the element is section or org-data, we also need
+ ;; to check the following element.
+ (memq (org-element-type element) '(section org-data)))
+ (setq lower element
+ node (avl-tree--node-right node)))
+ ;; We found an element in cache starting at POS. If `side'
+ ;; is `both' we also want the next one in order to generate
+ ;; a key in-between.
+ ;;
+ ;; If the element is the first row or item in a table or
+ ;; a plain list, we always return the table or the plain
+ ;; list.
+ ;;
+ ;; In any other case, we return the element found.
+ ((eq side 'both)
+ (setq lower element)
+ (setq node (avl-tree--node-right node)))
+ ((and (memq (org-element-type element) '(item table-row))
+ (let ((parent (org-element-property :parent element)))
+ (and (= (org-element-property :begin element)
+ (org-element-property :contents-begin parent))
+ (setq node nil
+ lower parent
+ upper parent)))))
+ (t
+ (setq node nil
+ lower element
+ upper element)))))
+ (pcase side
+ (`both (cons lower upper))
+ (`nil lower)
+ (_ upper)))))
(defun org-element--cache-put (element)
"Store ELEMENT in current buffer's cache, if allowed."
@@ -5307,21 +5751,43 @@ (defun org-element--cache-put (element)
;; During synchronization, first build an appropriate key for
;; the new element so `avl-tree-enter' can insert it at the
;; right spot in the cache.
- (let ((keys (org-element--cache-find
- (org-element-property :begin element) 'both)))
- (puthash element
- (org-element--cache-generate-key
- (and (car keys) (org-element--cache-key (car keys)))
- (cond ((cdr keys) (org-element--cache-key (cdr keys)))
- (org-element--cache-sync-requests
- (aref (car org-element--cache-sync-requests) 0))))
- org-element--cache-sync-keys)))
+ (let* ((keys (org-element--cache-find
+ (org-element-property :begin element) 'both))
+ (new-key (org-element--cache-generate-key
+ (and (car keys) (org-element--cache-key (car keys)))
+ (cond ((cdr keys) (org-element--cache-key (cdr keys)))
+ (org-element--cache-sync-requests
+ (org-element--request-key (car org-element--cache-sync-requests)))))))
+ (org-element-put-property element
+ :org-element--cache-sync-key
+ (cons org-element--cache-sync-keys-value new-key))))
+ (org-element--cache-log-message "Added new element with %S key: %S"
+ (org-element-property :org-element--cache-sync-key element)
+ (org-element--format-element element)
+ :level 2)
+ (org-element-put-property element :cached t)
+ (cl-incf org-element--cache-size)
(avl-tree-enter org-element--cache element)))
(defsubst org-element--cache-remove (element)
"Remove ELEMENT from cache.
Assume ELEMENT belongs to cache and that a cache is active."
- (avl-tree-delete org-element--cache element))
+ (org-element-put-property element :cached nil)
+ (cl-decf org-element--cache-size)
+ (let ((parent element))
+ (while (setq parent (org-element-property :parent parent))
+ (org-element-set-contents parent)))
+ (or (avl-tree-delete org-element--cache element)
+ (progn
+ ;; This should not happen, but if it is, would be better to know
+ ;; where it happens.
+ (org-element--cache-warn "Failed to delete %S element in %S at %S. The element cache key was %S."
+ (org-element-type element)
+ (current-buffer)
+ (org-element-property :begin element)
+ (org-element-property :org-element--cache-sync-key element))
+ (org-element-cache-reset)
+ (throw 'quit nil))))
;;;; Synchronization
@@ -5361,12 +5827,12 @@ (defsubst org-element--cache-shift-positions (element offset &optional props)
;; shifting it more than once.
(when (and (or (not props) (memq :structure props))
(eq (org-element-type element) 'plain-list)
- (not (eq (org-element-type (plist-get properties :parent))
- 'item)))
+ (not (eq (org-element-type (plist-get properties :parent)) 'item)))
(dolist (item (plist-get properties :structure))
(cl-incf (car item) offset)
(cl-incf (nth 6 item) offset)))
- (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated))
+ (dolist (key '( :begin :contents-begin :contents-end :end
+ :post-affiliated :robust-begin :robust-end))
(let ((value (and (or (not props) (memq key props))
(plist-get properties key))))
(and value (plist-put properties key (+ offset value)))))))
@@ -5385,42 +5851,68 @@ (defun org-element--cache-sync (buffer &optional threshold future-change)
in `org-element--cache-submit-request', where cache is partially
updated before current modification are actually submitted."
(when (buffer-live-p buffer)
- (with-current-buffer buffer
- (let ((inhibit-quit t) request next)
- (when org-element--cache-sync-timer
- (cancel-timer org-element--cache-sync-timer))
- (catch 'interrupt
- (while org-element--cache-sync-requests
- (setq request (car org-element--cache-sync-requests)
- next (nth 1 org-element--cache-sync-requests))
- (org-element--cache-process-request
- request
- (and next (aref next 0))
- threshold
- (and (not threshold)
- (org-time-add nil
- org-element-cache-sync-duration))
- future-change)
- ;; Request processed. Merge current and next offsets and
- ;; transfer ending position.
- (when next
- (cl-incf (aref next 3) (aref request 3))
- (aset next 2 (aref request 2)))
- (setq org-element--cache-sync-requests
- (cdr org-element--cache-sync-requests))))
- ;; If more requests are awaiting, set idle timer accordingly.
- ;; Otherwise, reset keys.
- (if org-element--cache-sync-requests
- (org-element--cache-set-timer buffer)
- (clrhash org-element--cache-sync-keys))))))
+ (with-current-buffer (or (buffer-base-buffer buffer) buffer)
+ ;; Check if the buffer have been changed outside visibility of
+ ;; `org-element--cache-before-change' and `org-element--cache-after-change'.
+ (if (/= org-element--cache-change-tic
+ (buffer-chars-modified-tick))
+ (progn
+ (org-element--cache-warn "Unregistered buffer modifications detected. Resetting\n The buffer is: %s\n Current command: %S"
+ (buffer-name (current-buffer))
+ this-command)
+ (org-element-cache-reset))
+ (let ((inhibit-quit t) request next)
+ (when org-element--cache-sync-timer
+ (cancel-timer org-element--cache-sync-timer))
+ (let ((time-limit (org-time-add nil org-element-cache-sync-duration)))
+ (catch 'interrupt
+ (when org-element--cache-sync-requests
+ (org-element--cache-log-message "Syncing down to %S-%S" (or future-change threshold) threshold))
+ (while org-element--cache-sync-requests
+ (setq request (car org-element--cache-sync-requests)
+ next (nth 1 org-element--cache-sync-requests))
+ (org-element--cache-process-request
+ request
+ (when next (org-element--request-key next))
+ threshold
+ (unless threshold time-limit)
+ future-change)
+ ;; Re-assign current and next requests. It could have
+ ;; been altered during phase 1.
+ (setq request (car org-element--cache-sync-requests)
+ next (nth 1 org-element--cache-sync-requests))
+ ;; Request processed. Merge current and next offsets and
+ ;; transfer ending position.
+ (when next
+ ;; The following requests can only be either phase 1
+ ;; or phase 2 requests. We need to let them know
+ ;; that additional shifting happened ahead of them.
+ (cl-incf (org-element--request-offset next) (org-element--request-offset request))
+ (org-element--cache-log-message "Updating next request offset to %d: %s"
+ (org-element--request-offset next)
+ (let ((print-length 10) (print-level 3)) (prin1-to-string next)))
+ ;; FIXME: END part of the request only matters for
+ ;; phase 0 requests. However, the only possible
+ ;; phase 0 request must be the first request in the
+ ;; list all the time. END position should be
+ ;; unused.
+ (setf (org-element--request-end next) (org-element--request-end request)))
+ (setq org-element--cache-sync-requests
+ (cdr org-element--cache-sync-requests)))))
+ ;; If more requests are awaiting, set idle timer accordingly.
+ ;; Otherwise, reset keys.
+ (if org-element--cache-sync-requests
+ (org-element--cache-set-timer buffer)
+ (setq org-element--cache-sync-keys-value (buffer-chars-modified-tick))))))))
(defun org-element--cache-process-request
- (request next threshold time-limit future-change)
+ (request next-request-key threshold time-limit future-change)
"Process synchronization REQUEST for all entries before NEXT.
REQUEST is a vector, built by `org-element--cache-submit-request'.
-NEXT is a cache key, as returned by `org-element--cache-key'.
+NEXT-REQUEST-KEY is a cache key of the next request, as returned by
+`org-element--cache-key'.
When non-nil, THRESHOLD is a buffer position. Synchronization
stops as soon as a shifted element begins after it.
@@ -5434,62 +5926,84 @@ (defun org-element--cache-process-request
Throw `interrupt' if the process stops before completing the
request."
+ (org-element--cache-log-message "org-element-cache: Processing request %s up to %S-%S, next: %S"
+ (let ((print-length 10) (print-level 3)) (prin1-to-string request))
+ future-change
+ threshold
+ next-request-key)
(catch 'quit
- (when (= (aref request 5) 0)
+ (when (= (org-element--request-phase request) 0)
;; Phase 0.
;;
- ;; Delete all elements starting after BEG, but not after buffer
- ;; position END or past element with key NEXT. Also delete
- ;; elements contained within a previously removed element
- ;; (stored in `last-container').
+ ;; Delete all elements starting after beginning of the element
+ ;; with request key NEXT, but not after buffer position END.
;;
;; At each iteration, we start again at tree root since
;; a deletion modifies structure of the balanced tree.
+ (org-element--cache-log-message "Phase 0")
(catch 'end-phase
- (while t
- (when (org-element--cache-interrupt-p time-limit)
- (throw 'interrupt nil))
- ;; Find first element in cache with key BEG or after it.
- (let ((beg (aref request 0))
- (end (aref request 2))
- (node (org-element--cache-root))
- data data-key last-container)
- (while node
- (let* ((element (avl-tree--node-data node))
- (key (org-element--cache-key element)))
- (cond
- ((org-element--cache-key-less-p key beg)
- (setq node (avl-tree--node-right node)))
- ((org-element--cache-key-less-p beg key)
- (setq data element
- data-key key
- node (avl-tree--node-left node)))
- (t (setq data element
+ (let ((deletion-count 0))
+ (while t
+ (when (org-element--cache-interrupt-p time-limit)
+ (org-element--cache-log-message "Interrupt: time limit")
+ (throw 'interrupt nil))
+ (let ((request-key (org-element--request-key request))
+ (end (org-element--request-end request))
+ (node (org-element--cache-root))
+ data data-key)
+ ;; Find first element in cache with key REQUEST-KEY or
+ ;; after it.
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (key (org-element--cache-key element)))
+ (cond
+ ((org-element--cache-key-less-p key request-key)
+ (setq node (avl-tree--node-right node)))
+ ((org-element--cache-key-less-p request-key key)
+ (setq data element
data-key key
- node nil)))))
- (if data
- (let ((pos (org-element-property :begin data)))
- (if (if (or (not next)
- (org-element--cache-key-less-p data-key next))
- (<= pos end)
- (and last-container
- (let ((up data))
- (while (and up (not (eq up last-container)))
- (setq up (org-element-property :parent up)))
- up)))
- (progn (when (and (not last-container)
- (> (org-element-property :end data)
- end))
- (setq last-container data))
- (org-element--cache-remove data))
- (aset request 0 data-key)
- (aset request 1 pos)
- (aset request 5 1)
- (throw 'end-phase nil)))
- ;; No element starting after modifications left in
- ;; cache: further processing is futile.
- (throw 'quit t))))))
- (when (= (aref request 5) 1)
+ node (avl-tree--node-left node)))
+ (t (setq data element
+ data-key key
+ node nil)))))
+ (if data
+ ;; We found first element in cache starting at or
+ ;; after REQUEST-KEY.
+ (let ((pos (org-element-property :begin data)))
+ ;; FIXME: Maybe simply (< pos end)?
+ (if (<= pos end)
+ (progn
+ (org-element--cache-log-message "removing %S::%S"
+ (org-element-property :org-element--cache-sync-key data)
+ (org-element--format-element data))
+ (cl-incf deletion-count)
+ (org-element--cache-remove data)
+ (when (and (> (log org-element--cache-size 2) 10)
+ (> deletion-count
+ (/ org-element--cache-size (log org-element--cache-size 2))))
+ (org-element--cache-log-message "Removed %S>N/LogN(=%S/%S) elements. Resetting cache to prevent performance degradation"
+ deletion-count
+ org-element--cache-size
+ (log org-element--cache-size 2))
+ (org-element-cache-reset)
+ (throw 'quit t)))
+ ;; Done deleting everthing starting before END.
+ ;; DATA-KEY is the first known element after END.
+ ;; Move on to phase 1.
+ (org-element--cache-log-message "found element after %d: %S::%S"
+ end
+ (org-element-property :org-element--cache-sync-key data)
+ (org-element--format-element data))
+ (setf (org-element--request-key request) data-key)
+ (setf (org-element--request-beg request) pos)
+ (setf (org-element--request-phase request) 1)
+ (throw 'end-phase nil)))
+ ;; No element starting after modifications left in
+ ;; cache: further processing is futile.
+ (org-element--cache-log-message "Phase 0 deleted all elements in cache after %S!"
+ request-key)
+ (throw 'quit t)))))))
+ (when (= (org-element--request-phase request) 1)
;; Phase 1.
;;
;; Phase 0 left a hole in the cache. Some elements after it
@@ -5515,31 +6029,57 @@ (defun org-element--cache-process-request
;; Note that we only need to get the parent from the first
;; element in cache after the hole.
;;
- ;; When next key is lesser or equal to the current one, delegate
- ;; phase 1 processing to next request in order to preserve key
- ;; order among requests.
- (let ((key (aref request 0)))
- (when (and next (not (org-element--cache-key-less-p key next)))
+ ;; When next key is lesser or equal to the current one, current
+ ;; request is inside a to-be-shifted part of the cache. It is
+ ;; fine because the order of elements will not be altered by
+ ;; shifting. However, we cannot know the real position of the
+ ;; unshifted NEXT element in the current request. So, we need
+ ;; to sort the request list according to keys and re-start
+ ;; processing from the new leftmost request.
+ (org-element--cache-log-message "Phase 1")
+ (let ((key (org-element--request-key request)))
+ (when (and next-request-key (not (org-element--cache-key-less-p key next-request-key)))
+ ;; In theory, the only case when requests are not
+ ;; ordered is when key of the next request is either the
+ ;; same with current key or it is a key for a removed
+ ;; element. Either way, we can simply merge the two
+ ;; requests.
(let ((next-request (nth 1 org-element--cache-sync-requests)))
- (aset next-request 0 key)
- (aset next-request 1 (aref request 1))
- (aset next-request 5 1))
- (throw 'quit t)))
+ (org-element--cache-log-message "Phase 1: Unorderered requests. Merging: %S\n%S\n"
+ (let ((print-length 10) (print-level 3)) (prin1-to-string request))
+ (let ((print-length 10) (print-level 3)) (prin1-to-string next-request)))
+ (setf (org-element--request-key next-request) key)
+ (setf (org-element--request-beg next-request) (org-element--request-beg request))
+ (setf (org-element--request-phase next-request) 1)
+ (throw 'quit t))))
;; Next element will start at its beginning position plus
;; offset, since it hasn't been shifted yet. Therefore, LIMIT
;; contains the real beginning position of the first element to
;; shift and re-parent.
- (let ((limit (+ (aref request 1) (aref request 3))))
- (cond ((and threshold (> limit threshold)) (throw 'interrupt nil))
+ (let ((limit (+ (org-element--request-beg request) (org-element--request-offset request))))
+ (cond ((and threshold (> limit threshold))
+ (org-element--cache-log-message "Interrupt: position %d after threshold %d" limit threshold)
+ (throw 'interrupt nil))
((and future-change (>= limit future-change))
- ;; Changes are going to happen around this element and
- ;; they will trigger another phase 1 request. Skip the
- ;; current one.
- (aset request 5 2))
+ ;; Changes happened around this element and they will
+ ;; trigger another phase 1 request. Skip re-parenting
+ ;; and simply proceed with shifting (phase 2) to make
+ ;; sure that followup phase 0 request for the recent
+ ;; changes can operate on the correctly shifted cache.
+ (org-element--cache-log-message "position %d after future change %d" limit future-change)
+ (setf (org-element--request-parent request) nil)
+ (setf (org-element--request-phase request) 2))
(t
- (let ((parent (org-element--parse-to limit t time-limit)))
- (aset request 4 parent)
- (aset request 5 2))))))
+ ;; No relevant changes happened after submitting this
+ ;; request. We are safe to look at the actual Org
+ ;; buffer and calculate the new parent.
+ (let ((parent (org-element--parse-to limit nil time-limit)))
+ (org-element--cache-log-message "New parent at %d: %S::%S"
+ limit
+ (org-element-property :org-element--cache-sync-key parent)
+ (org-element--format-element parent))
+ (setf (org-element--request-parent request) parent)
+ (setf (org-element--request-phase request) 2))))))
;; Phase 2.
;;
;; Shift all elements starting from key START, but before NEXT, by
@@ -5551,32 +6091,56 @@ (defun org-element--cache-process-request
;; Once THRESHOLD, if any, is reached, or once there is an input
;; pending, exit. Before leaving, the current synchronization
;; request is updated.
- (let ((start (aref request 0))
- (offset (aref request 3))
- (parent (aref request 4))
+ (org-element--cache-log-message "Phase 2")
+ (let ((start (org-element--request-key request))
+ (offset (org-element--request-offset request))
+ (parent (org-element--request-parent request))
(node (org-element--cache-root))
(stack (list nil))
(leftp t)
- exit-flag)
+ exit-flag continue-flag)
;; No re-parenting nor shifting planned: request is over.
- (when (and (not parent) (zerop offset)) (throw 'quit t))
+ (when (and (not parent) (zerop offset))
+ (org-element--cache-log-message "Empty offset. Request completed.")
+ (throw 'quit t))
(while node
(let* ((data (avl-tree--node-data node))
(key (org-element--cache-key data)))
+ ;; Traverse the cache tree. Ignore all the elements before
+ ;; START. Note that `avl-tree-stack' would not bypass the
+ ;; elements before START and thus would have beeen less
+ ;; efficient.
(if (and leftp (avl-tree--node-left node)
(not (org-element--cache-key-less-p key start)))
(progn (push node stack)
(setq node (avl-tree--node-left node)))
+ ;; Shift and re-parent when current node starts at or
+ ;; after START, but before NEXT.
(unless (org-element--cache-key-less-p key start)
;; We reached NEXT. Request is complete.
- (when (equal key next) (throw 'quit t))
+ (when (and next-request-key
+ (not (org-element--cache-key-less-p key next-request-key)))
+ (org-element--cache-log-message "Reached next request.")
+ (let ((next-request (nth 1 org-element--cache-sync-requests)))
+ (unless (and (org-element-property :cached (org-element--request-parent next-request))
+ (org-element-property :begin (org-element--request-parent next-request))
+ (> (org-element-property :begin (org-element--request-parent next-request))
+ (org-element-property :begin parent)))
+ (setf (org-element--request-parent next-request) parent)))
+ (throw 'quit t))
;; Handle interruption request. Update current request.
(when (or exit-flag (org-element--cache-interrupt-p time-limit))
- (aset request 0 key)
- (aset request 4 parent)
- (throw 'interrupt nil))
+ (org-element--cache-log-message "Interrupt: %s" (if exit-flag "threshold" "time limit"))
+ (setf (org-element--request-key request) key)
+ (setf (org-element--request-parent request) parent)
+ (throw 'interrupt nil))
;; Shift element.
(unless (zerop offset)
+ (org-element--cache-log-message "Shifting positions (𝝙%S) in %S::%S"
+ offset
+ (org-element-property :org-element--cache-sync-key data)
+ (org-element--format-element data)
+ :level 3)
(org-element--cache-shift-positions data offset))
(let ((begin (org-element-property :begin data)))
;; Update PARENT and re-parent DATA, only when
@@ -5585,25 +6149,93 @@ (defun org-element--cache-process-request
(<= (org-element-property :end parent) begin))
(setq parent (org-element-property :parent parent)))
(cond ((and (not parent) (zerop offset)) (throw 'quit nil))
+ ;; Consider scenario when DATA lays within
+ ;; sensitive lines of PARENT that was found
+ ;; during phase 2. For example:
+ ;;
+ ;; #+ begin_quote
+ ;; Paragraph
+ ;; #+end_quote
+ ;;
+ ;; In the above source block, remove space in
+ ;; the first line will trigger re-parenting of
+ ;; the paragraph and "#+end_quote" that is also
+ ;; considered paragraph before the modification.
+ ;; However, the paragraph element stored in
+ ;; cache must be deleted instead.
+ ((and parent
+ (or (not (memq (org-element-type parent) org-element-greater-elements))
+ (and (org-element-property :contents-begin parent)
+ (< (org-element-property :begin data) (org-element-property :contents-begin parent)))
+ (and (org-element-property :contents-end parent)
+ (>= (org-element-property :begin data) (org-element-property :contents-end parent)))
+ (> (org-element-property :end data) (org-element-property :end parent))
+ (and (org-element-property :contents-end data)
+ (> (org-element-property :contents-end data) (org-element-property :contents-end parent)))))
+ (org-element--cache-log-message "org-element-cache: Removing obsolete element with key %S::%S"
+ (org-element-property :org-element--cache-sync-key data)
+ (org-element--format-element data))
+ (org-element--cache-remove data)
+ ;; We altered the tree structure. The tree
+ ;; traversal needs to be restarted.
+ (setf (org-element--request-key request) key)
+ (setf (org-element--request-parent request) parent)
+ ;; Restart tree traversal.
+ (setq node (org-element--cache-root)
+ stack (list nil)
+ leftp t
+ begin -1
+ continue-flag t))
((and parent
+ (not (eq parent data))
(let ((p (org-element-property :parent data)))
(or (not p)
(< (org-element-property :begin p)
- (org-element-property :begin parent)))))
+ (org-element-property :begin parent))
+ (unless (eq p parent)
+ (not (org-element-property :cached p))
+ ;; (not (avl-tree-member-p org-element--cache p))
+ ))))
+ (org-element--cache-log-message "Updating parent in %S\n Old parent: %S\n New parent: %S"
+ (org-element--format-element data)
+ (org-element--format-element (org-element-property :parent data))
+ (org-element--format-element parent))
(org-element-put-property data :parent parent)
(let ((s (org-element-property :structure parent)))
(when (and s (org-element-property :structure data))
(org-element-put-property data :structure s)))))
;; Cache is up-to-date past THRESHOLD. Request
;; interruption.
- (when (and threshold (> begin threshold)) (setq exit-flag t))))
- (setq node (if (setq leftp (avl-tree--node-right node))
- (avl-tree--node-right node)
- (pop stack))))))
+ (when (and threshold (> begin threshold))
+ (org-element--cache-log-message "Reached threshold %d: %S"
+ threshold
+ (org-element--format-element data))
+ (setq exit-flag t))))
+ (if continue-flag
+ (setq continue-flag nil)
+ (setq node (if (setq leftp (avl-tree--node-right node))
+ (avl-tree--node-right node)
+ (pop stack)))))))
;; We reached end of tree: synchronization complete.
- t)))
-
-(defun org-element--parse-to (pos &optional syncp time-limit)
+ t))
+ (org-element--cache-log-message "org-element-cache: Finished process. The cache size is %d. The remaining sync requests: %S"
+ org-element--cache-size
+ (let ((print-level 2)) (prin1-to-string org-element--cache-sync-requests))))
+
+(defsubst org-element--open-end-p (element)
+ "Check if ELEMENT in current buffer contains extra blank lines after
+it and does not have closing term.
+
+Examples of such elements are: section, headline, org-data,
+and footnote-definition."
+ (and (org-element-property :contents-end element)
+ (= (org-element-property :contents-end element)
+ (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\n\t")
+ (line-beginning-position 2)))))
+
+(defun org-element--parse-to (pos &optional syncp time-limit recursive)
"Parse elements in current section, down to POS.
Start parsing from the closest between the last known element in
@@ -5614,128 +6246,173 @@ (defun org-element--parse-to (pos &optional syncp time-limit)
element containing POS instead. In that case, it is also
possible to provide TIME-LIMIT, which is a time value specifying
when the parsing should stop. The function throws `interrupt' if
-the process stopped before finding the expected result."
- (catch 'exit
- (org-with-wide-buffer
- (goto-char pos)
- (let* ((cached (and (org-element--cache-active-p)
- (org-element--cache-find pos nil)))
- (begin (org-element-property :begin cached))
- element next mode)
- (cond
- ;; Nothing in cache before point: start parsing from first
- ;; element following headline above, or first element in
- ;; buffer.
- ((not cached)
- (if (org-with-limited-levels (outline-previous-heading))
- (progn
- (setq mode 'planning)
- (forward-line))
- (setq mode 'top-comment))
- (skip-chars-forward " \r\t\n")
- (beginning-of-line))
- ;; Cache returned exact match: return it.
- ((= pos begin)
- (throw 'exit (if syncp (org-element-property :parent cached) cached)))
- ;; There's a headline between cached value and POS: cached
- ;; value is invalid. Start parsing from first element
- ;; following the headline.
- ((re-search-backward
- (org-with-limited-levels org-outline-regexp-bol) begin t)
- (forward-line)
- (skip-chars-forward " \r\t\n")
- (beginning-of-line)
- (setq mode 'planning))
- ;; Check if CACHED or any of its ancestors contain point.
- ;;
- ;; If there is such an element, we inspect it in order to know
- ;; if we return it or if we need to parse its contents.
- ;; Otherwise, we just start parsing from current location,
- ;; which is right after the top-most element containing
- ;; CACHED.
- ;;
- ;; As a special case, if POS is at the end of the buffer, we
- ;; want to return the innermost element ending there.
- ;;
- ;; Also, if we find an ancestor and discover that we need to
- ;; parse its contents, make sure we don't start from
- ;; `:contents-begin', as we would otherwise go past CACHED
- ;; again. Instead, in that situation, we will resume parsing
- ;; from NEXT, which is located after CACHED or its higher
- ;; ancestor not containing point.
- (t
- (let ((up cached)
- (pos (if (= (point-max) pos) (1- pos) pos)))
- (goto-char (or (org-element-property :contents-begin cached) begin))
- (while (let ((end (org-element-property :end up)))
- (and (<= end pos)
- (goto-char end)
- (setq up (org-element-property :parent up)))))
- (cond ((not up))
- ((eobp) (setq element up))
- (t (setq element up next (point)))))))
- ;; Parse successively each element until we reach POS.
- (let ((end (or (org-element-property :end element)
- (save-excursion
- (org-with-limited-levels (outline-next-heading))
- (point))))
- (parent element))
- (while t
- (when syncp
- (cond ((= (point) pos) (throw 'exit parent))
- ((org-element--cache-interrupt-p time-limit)
- (throw 'interrupt nil))))
- (unless element
- (setq element (org-element--current-element
- end 'element mode
- (org-element-property :structure parent)))
- (org-element-put-property element :parent parent)
- (org-element--cache-put element))
- (let ((elem-end (org-element-property :end element))
- (type (org-element-type element)))
- (cond
- ;; Skip any element ending before point. Also skip
- ;; element ending at point (unless it is also the end of
- ;; buffer) since we're sure that another element begins
- ;; after it.
- ((and (<= elem-end pos) (/= (point-max) elem-end))
- (goto-char elem-end)
- (setq mode (org-element--next-mode mode type nil)))
- ;; A non-greater element contains point: return it.
- ((not (memq type org-element-greater-elements))
- (throw 'exit element))
- ;; Otherwise, we have to decide if ELEMENT really
- ;; contains POS. In that case we start parsing from
- ;; contents' beginning.
- ;;
- ;; If POS is at contents' beginning but it is also at
- ;; the beginning of the first item in a list or a table.
- ;; In that case, we need to create an anchor for that
- ;; list or table, so return it.
- ;;
- ;; Also, if POS is at the end of the buffer, no element
- ;; can start after it, but more than one may end there.
- ;; Arbitrarily, we choose to return the innermost of
- ;; such elements.
- ((let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
- (when (or syncp
- (and cbeg cend
- (or (< cbeg pos)
- (and (= cbeg pos)
- (not (memq type '(plain-list table)))))
- (or (> cend pos)
- (and (= cend pos) (= (point-max) pos)))))
- (goto-char (or next cbeg))
- (setq next nil
- mode (org-element--next-mode mode type t)
- parent element
- end cend))))
- ;; Otherwise, return ELEMENT as it is the smallest
- ;; element containing POS.
- (t (throw 'exit element))))
- (setq element nil)))))))
+the process stopped before finding the expected result.
+When optional argument RECURSIVE is non-nil, parse element recursively."
+ (catch 'exit
+ (save-match-data
+ (org-with-wide-buffer
+ (goto-char pos)
+ (save-excursion
+ (end-of-line)
+ (skip-chars-backward " \r\t\n")
+ ;; Within blank lines at the beginning of buffer, return nil.
+ (when (bobp) (throw 'exit nil)))
+ (let* ((cached (and (org-element--cache-active-p)
+ (org-element--cache-find pos nil)))
+ (mode (org-element-property :mode cached))
+ element next)
+ (cond
+ ;; Nothing in cache before point: start parsing from first
+ ;; element in buffer down to POS or from the beginning of the
+ ;; file.
+ ((and (not cached) (org-element--cache-active-p))
+ (setq element (org-element-org-data-parser))
+ (unless (org-element-property :begin element) (org-element--cache-warn "Error parsing org-data. Got %S" element))
+ (org-element--cache-log-message "Nothing in cache. Adding org-data: %S"
+ (org-element--format-element element))
+ (org-element--cache-put element)
+ (goto-char (org-element-property :contents-begin element))
+ (setq mode 'org-data))
+ ;; Nothing in cache before point because cache is not active.
+ ;; Parse from previous heading to avoid re-parsing the whole
+ ;; buffer above. This comes at the cost of not calculating
+ ;; `:parent' property for headings.
+ ((not cached)
+ (if (org-with-limited-levels (outline-previous-heading))
+ (progn
+ (setq element (org-element-headline-parser nil 'fast))
+ (setq mode 'planning)
+ (forward-line))
+ (setq mode 'top-comment))
+ (org-skip-whitespace)
+ (beginning-of-line))
+ ;; Check if CACHED or any of its ancestors contain point.
+ ;;
+ ;; If there is such an element, we inspect it in order to know
+ ;; if we return it or if we need to parse its contents.
+ ;; Otherwise, we just start parsing from location, which is
+ ;; right after the top-most element containing CACHED but
+ ;; still before POS.
+ ;;
+ ;; As a special case, if POS is at the end of the buffer, we
+ ;; want to return the innermost element ending there.
+ ;;
+ ;; Also, if we find an ancestor and discover that we need to
+ ;; parse its contents, make sure we don't start from
+ ;; `:contents-begin', as we would otherwise go past CACHED
+ ;; again. Instead, in that situation, we will resume parsing
+ ;; from NEXT, which is located after CACHED or its higher
+ ;; ancestor not containing point.
+ (t
+ (let ((up cached)
+ (pos (if (= (point-max) pos) (1- pos) pos)))
+ (while (and up (<= (org-element-property :end up) pos))
+ (goto-char (org-element-property :end up))
+ (setq element up
+ mode (org-element--next-mode (org-element-property :mode element) (org-element-type element) nil)
+ up (org-element-property :parent up)
+ next (point)))
+ (when up (setq element up)))))
+ ;; Parse successively each element until we reach POS.
+ (let ((end (or (org-element-property :end element) (point-max)))
+ (parent (org-element-property :parent element)))
+ (while t
+ (when (org-element--cache-interrupt-p time-limit)
+ (throw 'interrupt nil))
+ (unless element
+ (setq element (org-element--current-element
+ end 'element mode
+ (org-element-property :structure parent)))
+ ;; Make sure that we return referenced element in cache
+ ;; that can be altered directly.
+ (setq element (or (org-element--cache-put element) element))
+ ;; Nothing to parse (i.e. empty file).
+ (unless element (throw 'exit parent))
+ (org-element-put-property element :parent parent))
+ (let ((elem-end (org-element-property :end element))
+ (type (org-element-type element)))
+ (cond
+ ;; Skip any element ending before point. Also skip
+ ;; element ending at point (unless it is also the end of
+ ;; buffer) since we're sure that another element begins
+ ;; after it.
+ ((and (<= elem-end pos) (/= (point-max) elem-end))
+ (when (and recursive
+ (org-element-property :contents-end element))
+ (org-element--parse-to (1- (org-element-property :contents-end element))
+ nil time-limit recursive))
+ ;; Avoid parsing headline siblings above.
+ (goto-char elem-end)
+ (when (eq type 'headline)
+ (save-match-data
+ (unless (when (and (/= 1 (org-element-property :level element))
+ (re-search-forward
+ (rx-to-string
+ `(and bol (repeat 1 ,(1- (org-element-property :level element)) "*") " "))
+ pos t))
+ (beginning-of-line)
+ t)
+ (goto-char pos)
+ (re-search-backward
+ (rx-to-string
+ `(and bol (repeat ,(org-element-property :level element) "*") " "))
+ elem-end t))))
+ (setq mode (org-element--next-mode mode type nil)))
+ ;; A non-greater element contains point: return it.
+ ((not (memq type org-element-greater-elements))
+ (throw 'exit (if syncp parent element)))
+ ;; Otherwise, we have to decide if ELEMENT really
+ ;; contains POS. In that case we start parsing from
+ ;; contents' beginning.
+ ;;
+ ;; If POS is at contents' beginning but it is also at
+ ;; the beginning of the first item in a list or a table.
+ ;; In that case, we need to create an anchor for that
+ ;; list or table, so return it.
+ ;;
+ ;; Also, if POS is at the end of the buffer, no element
+ ;; can start after it, but more than one may end there.
+ ;; Arbitrarily, we choose to return the innermost of
+ ;; such elements.
+ ((let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (when (and cbeg cend
+ (or (< cbeg pos)
+ (and (= cbeg pos)
+ (not (memq type '(plain-list table)))))
+ (or (> cend pos)
+ ;; When we are at cend or within blank
+ ;; lines after, it is a special case:
+ ;; 1. At the end of buffer we return
+ ;; the innermost element.
+ ;; 2. At cend of element with return
+ ;; that element.
+ ;; 3. At the end of element, we would
+ ;; return in the earlier cond form.
+ ;; 4. Within blank lines after cend,
+ ;; when element does not have a
+ ;; closing keyword, we return that
+ ;; outermost element, unless the
+ ;; outermost element is a non-empty
+ ;; headline. In the latter case, we
+ ;; return the outermost element inside
+ ;; the headline section.
+ (and (org-element--open-end-p element)
+ (or (= (org-element-property :end element) (point-max))
+ (and (> pos (org-element-property :contents-end element))
+ (memq (org-element-type element) '(org-data section headline)))))))
+ (goto-char (or next cbeg))
+ (setq mode (if next mode (org-element--next-mode mode type t))
+ next nil
+ parent element
+ end (if (org-element--open-end-p element)
+ (org-element-property :end element)
+ (org-element-property :contents-end element))))))
+ ;; Otherwise, return ELEMENT as it is the smallest
+ ;; element containing POS.
+ (t (throw 'exit (if syncp parent element)))))
+ (setq element nil))))))))
;;;; Staging Buffer Changes
@@ -5745,6 +6422,8 @@ (defconst org-element--cache-sensitive-re
"\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|"
"^[ \t]*\\(?:"
"#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|"
+ org-list-full-item-re "\\|"
+ ":\\(?: \\|$\\)" "\\|"
"\\\\begin{[A-Za-z0-9*]+}" "\\|"
":\\(?:\\w\\|[-_]\\)+:[ \t]*$"
"\\)")
@@ -5756,64 +6435,82 @@ (defconst org-element--cache-sensitive-re
(defvar org-element--cache-change-warning nil
"Non-nil when a sensitive line is about to be changed.
-It is a symbol among nil, t and `headline'.")
+It is a symbol among nil, t, or a number representing smallest level of
+modified headline. The level considers headline levels both before
+and after the modification.")
(defun org-element--cache-before-change (beg end)
- "Request extension of area going to be modified if needed.
+ "Detect modifications in sensitive parts of Org buffer.
BEG and END are the beginning and end of the range of changed
-text. See `before-change-functions' for more information."
- (when (org-element--cache-active-p)
- (org-with-wide-buffer
- (goto-char beg)
- (beginning-of-line)
- (let ((bottom (save-excursion (goto-char end) (line-end-position))))
- (setq org-element--cache-change-warning
- (save-match-data
- (if (and (org-with-limited-levels (org-at-heading-p))
- (= (line-end-position) bottom))
- 'headline
- (let ((case-fold-search t))
- (re-search-forward
- org-element--cache-sensitive-re bottom t)))))))))
+text. See `before-change-functions' for more information.
+
+The function returns the new value of `org-element--cache-change-warning'."
+ (when (org-element--cache-active-p t)
+ (with-current-buffer (or (buffer-base-buffer (current-buffer))
+ (current-buffer))
+ (org-with-wide-buffer
+ (setq org-element--cache-change-tic (buffer-chars-modified-tick))
+ (goto-char beg)
+ (beginning-of-line)
+ (let ((bottom (save-excursion (goto-char end) (line-end-position))))
+ (prog1
+ (let ((org-element--cache-change-warning-before org-element--cache-change-warning)
+ (org-element--cache-change-warning-after))
+ (setq org-element--cache-change-warning-after
+ (save-match-data
+ (let ((case-fold-search t))
+ (when (re-search-forward
+ org-element--cache-sensitive-re bottom t)
+ (goto-char beg)
+ (beginning-of-line)
+ (let (min-level)
+ (cl-loop while (re-search-forward
+ (rx-to-string
+ (if min-level
+ `(and bol (repeat 1 ,(1- min-level) "*") " ")
+ `(and bol (+ "*") " ")))
+ bottom t)
+ do (setq min-level (1- (length (match-string 0))))
+ until (= min-level 1))
+ (goto-char beg)
+ (beginning-of-line)
+ (or min-level
+ (when (looking-at-p "^[ \t]*#\\+CATEGORY:")
+ 'org-data)
+ t))))))
+ (setq org-element--cache-change-warning
+ (cond
+ ((and (numberp org-element--cache-change-warning-before)
+ (numberp org-element--cache-change-warning-after))
+ (min org-element--cache-change-warning-after
+ org-element--cache-change-warning-before))
+ ((numberp org-element--cache-change-warning-before)
+ org-element--cache-change-warning-before)
+ ((numberp org-element--cache-change-warning-after)
+ org-element--cache-change-warning-after)
+ (t (or org-element--cache-change-warning-after
+ org-element--cache-change-warning-before)))))
+ (org-element--cache-log-message "%S is about to modify text: warning %S"
+ this-command
+ org-element--cache-change-warning)))))))
(defun org-element--cache-after-change (beg end pre)
"Update buffer modifications for current buffer.
BEG and END are the beginning and end of the range of changed
text, and the length in bytes of the pre-change text replaced by
that range. See `after-change-functions' for more information."
- (when (org-element--cache-active-p)
- (org-with-wide-buffer
- (goto-char beg)
- (beginning-of-line)
- (save-match-data
- (let ((top (point))
- (bottom (save-excursion (goto-char end) (line-end-position))))
- ;; Determine if modified area needs to be extended, according
- ;; to both previous and current state. We make a special
- ;; case for headline editing: if a headline is modified but
- ;; not removed, do not extend.
- (when (pcase org-element--cache-change-warning
- (`t t)
- (`headline
- (not (and (org-with-limited-levels (org-at-heading-p))
- (= (line-end-position) bottom))))
- (_
- (let ((case-fold-search t))
- (re-search-forward
- org-element--cache-sensitive-re bottom t))))
- ;; Effectively extend modified area.
- (org-with-limited-levels
- (setq top (progn (goto-char top)
- (when (outline-previous-heading) (forward-line))
- (point)))
- (setq bottom (progn (goto-char bottom)
- (if (outline-next-heading) (1- (point))
- (point))))))
- ;; Store synchronization request.
- (let ((offset (- end beg pre)))
- (org-element--cache-submit-request top (- bottom offset) offset)))))
- ;; Activate a timer to process the request during idle time.
- (org-element--cache-set-timer (current-buffer))))
+ (when (org-element--cache-active-p t)
+ (with-current-buffer (or (buffer-base-buffer (current-buffer))
+ (current-buffer))
+ (when (not (eq org-element--cache-change-tic (buffer-chars-modified-tick)))
+ (org-element--cache-log-message "After change")
+ (setq org-element--cache-change-warning (org-element--cache-before-change beg end))
+ ;; Store synchronization request.
+ (let ((offset (- end beg pre)))
+ (save-match-data
+ (org-element--cache-submit-request beg (- end offset) offset)))
+ ;; Activate a timer to process the request during idle time.
+ (org-element--cache-set-timer (current-buffer))))))
(defun org-element--cache-for-removal (beg end offset)
"Return first element to remove from cache.
@@ -5825,7 +6522,13 @@ (defun org-element--cache-for-removal (beg end offset)
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."
+changes. In the latter case, the returned element is the outermost
+non-robust element affected by the changes. Note that the returned
+element may end before END position in which case some cached element
+starting after the returned may still be affected by the changes.
+
+Also, when there are no elements in cache before BEG, return first
+known element in cache (it may start after END)."
(let* ((elements (org-element--cache-find (1- beg) 'both))
(before (car elements))
(after (cdr elements)))
@@ -5834,34 +6537,108 @@ (defun org-element--cache-for-removal (beg end offset)
(robust-flag t))
(while up
(if (let ((type (org-element-type up)))
- (and (or (memq type '(center-block dynamic-block quote-block
- special-block))
- ;; Drawers named "PROPERTIES" are probably
- ;; a properties drawer being edited. Force
- ;; parsing to check if editing is over.
- (and (eq type 'drawer)
- (not (string=
- (org-element-property :drawer-name up)
- "PROPERTIES"))))
- (let ((cbeg (org-element-property :contents-begin up)))
- (and cbeg
- (<= cbeg beg)
- (> (org-element-property :contents-end up) end)))))
+ (or (and (memq type '( center-block dynamic-block
+ quote-block special-block))
+ ;; Sensitive change. This is
+ ;; unconditionally non-robust change.
+ (not org-element--cache-change-warning)
+ (let ((cbeg (org-element-property :contents-begin up))
+ (cend (org-element-property :contents-end up)))
+ (and cbeg
+ (<= cbeg beg)
+ (or (> cend end)
+ (and (= cend end)
+ (= (+ end offset) (point-max)))))))
+ (and (memq type '(headline section org-data))
+ (let ((rbeg (org-element-property :robust-begin up))
+ (rend (org-element-property :robust-end up)))
+ (and rbeg rend
+ (<= rbeg beg)
+ (or (> rend end)
+ (and (= rend end)
+ (= (+ end offset) (point-max))))))
+ (pcase type
+ ;; Sensitive change in section. Need to
+ ;; re-parse.
+ (`section (not org-element--cache-change-warning))
+ ;; Headline might be inserted. This is non-robust
+ ;; change when `up' is a `headline' or `section'
+ ;; with `>' level compared to the inserted headline.
+ ;;
+ ;; Also, planning info/property drawer
+ ;; could have been inserted. It is not
+ ;; robust change then.
+ (`headline
+ (and
+ (or (not (numberp org-element--cache-change-warning))
+ (> org-element--cache-change-warning
+ (org-element-property :level up)))
+ (org-with-point-at (org-element-property :contents-begin up)
+ (unless
+ (save-match-data
+ (when (looking-at-p org-planning-line-re)
+ (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (< beg (match-end 0))))
+ 'robust))))
+ (`org-data (not (eq org-element--cache-change-warning 'org-data)))
+ (_ 'robust)))))
;; UP is a robust greater element containing changes.
;; We only need to extend its ending boundaries.
- (org-element--cache-shift-positions
- up offset '(:contents-end :end))
- (setq before up)
- (when robust-flag (setq robust-flag nil)))
+ (progn
+ (org-element--cache-shift-positions
+ up offset
+ (if (and (org-element-property :robust-begin up)
+ (org-element-property :robust-end up))
+ '(:contents-end :end :robust-end)
+ '(:contents-end :end)))
+ (org-element--cache-log-message "Shifting end positions of robust parent: %S"
+ (org-element--format-element up)))
+ (unless (or
+ ;; UP is non-robust. Yet, if UP is headline, flagging
+ ;; everything inside for removal may be to
+ ;; costly. Instead, we should better re-parse only the
+ ;; headline itself when possible. If a headline is still
+ ;; starting from old :begin position, we do not care that
+ ;; its boundaries could have extended to shrinked - we
+ ;; will re-parent and shift them anyway.
+ (and (eq 'headline (org-element-type up))
+ ;; The change is not inside headline. Not
+ ;; updating here.
+ (not (<= beg (org-element-property :begin up)))
+ (not (>= end (org-element-property :end up)))
+ (let ((current (org-with-point-at (org-element-property :begin up)
+ (cl-letf (((symbol-function #'org-element--cache-active-p) (lambda () nil)))
+ (org-element--current-element (point-max))))))
+ (when (eq 'headline (org-element-type current))
+ (org-element--cache-log-message "Found non-robust headline that can be updated individually: %S"
+ (org-element--format-element current))
+ (org-element-set-element up current)
+ t)))
+ ;; If UP is org-data, the situation is similar to
+ ;; headline case. We just need to re-parse the
+ ;; org-data itself.
+ (when (eq 'org-data (org-element-type up))
+ (org-element-set-element up (org-with-point-at 1 (org-element-org-data-parser)))
+ (org-element--cache-log-message "Found non-robust change invalidating org-data. Re-parsing: %S"
+ (org-element--format-element up))
+ t))
+ (org-element--cache-log-message "Found non-robust element: %S"
+ (org-element--format-element up))
+ (setq before up)
+ (when robust-flag (setq robust-flag nil))))
+ (unless (or (org-element-property :parent up)
+ (eq 'org-data (org-element-type up)))
+ (org-element--cache-warn "Got element without parent.\n%S" up))
(setq up (org-element-property :parent 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.
- ;;
- ;; As a special case, do not remove BEFORE if it is a robust
- ;; container for current changes.
- (if (or (< (org-element-property :end before) beg) robust-flag) after
+ ;; 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.
+ ;;
+ ;; As a special case, do not remove BEFORE if it is a robust
+ ;; container for current changes.
+ (if (or (< (org-element-property :end before) beg) robust-flag) after
before)))))
(defun org-element--cache-submit-request (beg end offset)
@@ -5869,68 +6646,209 @@ (defun org-element--cache-submit-request (beg end offset)
BEG and END are buffer positions delimiting the minimal area
where cache data should be removed. OFFSET is the size of the
change, as an integer."
- (let ((next (car org-element--cache-sync-requests))
- delete-to delete-from)
- (if (and next
- (zerop (aref next 5))
- (> (setq delete-to (+ (aref next 2) (aref next 3))) end)
- (<= (setq delete-from (aref next 1)) end))
- ;; Current changes can be merged with first sync request: we
- ;; can save a partial cache synchronization.
- (progn
- (cl-incf (aref next 3) offset)
- ;; If last change happened within area to be removed, extend
- ;; boundaries of robust parents, if any. Otherwise, find
- ;; first element to remove and update request accordingly.
- (if (> beg delete-from)
- (let ((up (aref next 4)))
- (while up
- (org-element--cache-shift-positions
- up offset '(:contents-end :end))
- (setq up (org-element-property :parent up))))
- (let ((first (org-element--cache-for-removal beg delete-to offset)))
- (when first
- (aset next 0 (org-element--cache-key first))
- (aset next 1 (org-element-property :begin first))
- (aset next 4 (org-element-property :parent first))))))
- ;; Ensure cache is correct up to END. Also make sure that NEXT,
- ;; if any, is no longer a 0-phase request, thus ensuring that
- ;; phases are properly ordered. We need to provide OFFSET as
- ;; optional parameter since current modifications are not known
- ;; yet to the otherwise correct part of the cache (i.e, before
- ;; the first request).
- (when next (org-element--cache-sync (current-buffer) end beg))
- (let ((first (org-element--cache-for-removal beg end offset)))
- (if first
- (push (let ((beg (org-element-property :begin first))
- (key (org-element--cache-key first)))
- (cond
- ;; When changes happen before the first known
- ;; element, re-parent and shift the rest of the
- ;; cache.
- ((> beg end) (vector key beg nil offset nil 1))
- ;; Otherwise, we find the first non robust
- ;; element containing END. All elements between
- ;; FIRST and this one are to be removed.
- ((let ((first-end (org-element-property :end first)))
- (and (> first-end end)
- (vector key beg first-end offset first 0))))
- (t
- (let* ((element (org-element--cache-find end))
- (end (org-element-property :end element))
- (up element))
- (while (and (setq up (org-element-property :parent up))
- (>= (org-element-property :begin up) beg))
- (setq end (org-element-property :end up)
- element up))
- (vector key beg end offset element 0)))))
- org-element--cache-sync-requests)
- ;; No element to remove. No need to re-parent either.
- ;; Simply shift additional elements, if any, by OFFSET.
- (when org-element--cache-sync-requests
- (cl-incf (aref (car org-element--cache-sync-requests) 3)
- offset)))))))
-
+ (org-element--cache-log-message "Submitting new synchronization request for [%S..%S]𝝙%S"
+ beg end offset)
+ (with-current-buffer (or (buffer-base-buffer (current-buffer))
+ (current-buffer))
+ (let ((next (car org-element--cache-sync-requests))
+ delete-to delete-from)
+ (if (and next
+ ;; First existing sync request is in phase 0.
+ (= 0 (org-element--request-phase next))
+ ;; Current changes intersect with the first sync request.
+ (> (setq delete-to (+ (org-element--request-end next)
+ (org-element--request-offset next)))
+ end)
+ (<= (setq delete-from (org-element--request-beg next))
+ end))
+ ;; Current changes can be merged with first sync request: we
+ ;; can save a partial cache synchronization.
+ (progn
+ (org-element--cache-log-message "Found another phase 0 request intersecting with current")
+ ;; Update OFFSET of the existing request.
+ (cl-incf (org-element--request-offset next) offset)
+ ;; If last change happened within area to be removed, extend
+ ;; boundaries of robust parents, if any. Otherwise, find
+ ;; first element to remove and update request accordingly.
+ (if (> beg delete-from)
+ ;; The current modification is completely inside NEXT.
+ ;; We already added the current OFFSET to the NEXT
+ ;; request. However, the robust elements around
+ ;; modifications also need to be shifted. Moreover, the
+ ;; new modification may also have non-nil
+ ;; `org-element--cache-change-warning'. In the latter case, we
+ ;; also need to update the request.
+ (let ((first (org-element--cache-for-removal beg end offset) ; Shift as needed.
+ ))
+ (org-element--cache-log-message "Current request is inside next. Candidate parent: %S"
+ (org-element--format-element first))
+ (when
+ ;; Non-robust element is now before NEXT. Need to
+ ;; update.
+ (and first
+ (org-element--cache-key-less-p (org-element--cache-key first)
+ (org-element--request-key next)))
+ (org-element--cache-log-message "Current request is inside next. New parent: %S"
+ (org-element--format-element first))
+ (setf (org-element--request-key next) (org-element--cache-key first))
+ (setf (org-element--request-beg next) (org-element-property :begin first))
+ (setf (org-element--request-end next) (max (org-element-property :end first)
+ (org-element--request-end next)))
+ (setf (org-element--request-parent next) (org-element-property :parent first))))
+ ;; The current and NEXT modifications are intersecting
+ ;; with current modification starting before NEXT and NEXT
+ ;; ending after current. We need to update the common
+ ;; non-robust parent for the new extended modification
+ ;; region.
+ (let ((first (org-element--cache-for-removal beg delete-to offset)))
+ (org-element--cache-log-message "Current request intersects with next. Candidate parent: %S"
+ (org-element--format-element first))
+ (when (and first
+ (org-element--cache-key-less-p (org-element--cache-key first)
+ (org-element--request-key next)))
+ (org-element--cache-log-message "Current request intersects with next. Updating. New parent: %S"
+ (org-element--format-element first))
+ (setf (org-element--request-key next) (org-element--cache-key first))
+ (setf (org-element--request-beg next) (org-element-property :begin first))
+ (setf (org-element--request-end next) (max (org-element-property :end first)
+ (org-element--request-end next)))
+ (setf (org-element--request-parent next) (org-element-property :parent first))))))
+ ;; Ensure cache is correct up to END. Also make sure that NEXT,
+ ;; if any, is no longer a 0-phase request, thus ensuring that
+ ;; phases are properly ordered. We need to provide OFFSET as
+ ;; optional parameter since current modifications are not known
+ ;; yet to the otherwise correct part of the cache (i.e, before
+ ;; the first request).
+ (org-element--cache-log-message "Adding new phase 0 request")
+ ;; FIXME: Disabling this optimisation to hunt errors.
+ ;; (when next (org-element--cache-sync (current-buffer) end beg))
+ (when next (org-element--cache-sync (current-buffer) end))
+ (let ((first (org-element--cache-for-removal beg end offset)))
+ (if first
+ (push (let ((first-beg (org-element-property :begin first))
+ (key (org-element--cache-key first)))
+ (cond
+ ;; When changes happen before the first known
+ ;; element, re-parent and shift the rest of the
+ ;; cache.
+ ((> first-beg end)
+ (org-element--cache-log-message "Changes are before first known element. Submitting phase 1 request")
+ (vector key first-beg nil offset nil 1))
+ ;; Otherwise, we find the first non robust
+ ;; element containing END. All elements between
+ ;; FIRST and this one are to be removed.
+ ;;
+ ;; The current modification is completely inside
+ ;; FIRST. Clear and update cached elements in
+ ;; region containing FIRST.
+ ((let ((first-end (org-element-property :end first)))
+ (when (> first-end end)
+ (org-element--cache-log-message "Extending to non-robust element %S" (org-element--format-element first))
+ (vector key first-beg first-end offset (org-element-property :parent first) 0))))
+ (t
+ ;; Now, FIRST is the first element after BEG or
+ ;; non-robust element containing BEG. However,
+ ;; FIRST ends before END and there might be
+ ;; another ELEMENT before END that spans beyond
+ ;; END. If there is such element, we need to
+ ;; extend the region down to end of the common
+ ;; parent of FIRST and everything inside
+ ;; BEG..END.
+ (let* ((element (org-element--cache-find end))
+ (element-end (org-element-property :end element))
+ (up element))
+ (while (and (not (eq up first))
+ (setq up (org-element-property :parent up))
+ (>= (org-element-property :begin up) first-beg))
+ ;; Note that UP might have been already
+ ;; shifted if it is a robust element. After
+ ;; deletion, it can put it's end before yet
+ ;; unprocessed ELEMENT.
+ (setq element-end (max (org-element-property :end up) element-end)
+ element up))
+ ;; Extend region to remove elements between
+ ;; beginning of first and the end of outermost
+ ;; element starting before END but after
+ ;; beginning of first.
+ ;; of the FIRST.
+ (org-element--cache-log-message "Extending to all elements between:\n 1: %S\n 2: %S"
+ (org-element--format-element first)
+ (org-element--format-element element))
+ (vector key first-beg element-end offset up 0)))))
+ org-element--cache-sync-requests)
+ ;; No element to remove. No need to re-parent either.
+ ;; Simply shift additional elements, if any, by OFFSET.
+ (if org-element--cache-sync-requests
+ (progn
+ (org-element--cache-log-message "Nothing to remove. Updating offset of the next request by 𝝙%d: %S"
+ offset
+ (let ((print-level 3))
+ (car org-element--cache-sync-requests)))
+ (cl-incf (org-element--request-offset (car org-element--cache-sync-requests))
+ offset))
+ (org-element--cache-log-message "Nothing to remove. No elements in cache after %d. Terminating."
+ end))))))
+ (setq org-element--cache-change-warning nil)))
+
+(defun org-element--cache-verify-element (element)
+ "Verify correctness of ELEMENT when `org-element--cache-self-verify' is non-nil.
+
+Return non-nil when verification failed."
+ ;; Verify correct parent for the element.
+ (let ((org-element--cache-self-verify (or org-element--cache-self-verify
+ (and (boundp 'org-batch-test) org-batch-test)))
+ (org-element--cache-self-verify-frequency (if (and (boundp 'org-batch-test) org-batch-test)
+ 1
+ org-element--cache-self-verify-frequency)))
+ (when (and org-element--cache-self-verify
+ (org-element--cache-active-p)
+ (derived-mode-p 'org-mode)
+ (org-element-property :parent element)
+ (eq 'headline (org-element-type element))
+ ;; Avoid too much slowdown
+ (< (random 1000) (* 1000 org-element--cache-self-verify-frequency)))
+ (org-with-point-at (org-element-property :begin element)
+ (org-element-with-disabled-cache (org-up-heading-or-point-min))
+ (unless (or (= (point) (org-element-property :begin (org-element-property :parent element)))
+ (eq (point) (point-min)))
+ (org-element--cache-warn "Cached element has wrong parent in %s. Resetting.\n The element is: %S\n The parent is: %S\n The real parent is: %S"
+ (buffer-name (current-buffer))
+ (org-element--format-element element)
+ (org-element--format-element (org-element-property :parent element))
+ (org-element--format-element (org-element--current-element (org-element-property :end (org-element-property :parent element)))))
+ (org-element-cache-reset))
+ (org-element--cache-verify-element (org-element-property :parent element))))
+ ;; Verify the element itself.
+ (when (and org-element--cache-self-verify
+ (org-element--cache-active-p)
+ element
+ (not (memq (org-element-type element) '(section org-data)))
+ ;; Avoid too much slowdown
+ (< (random 1000) (* 1000 org-element--cache-self-verify-frequency)))
+ (let ((real-element (let (org-element-use-cache)
+ (org-element--parse-to
+ (if (memq (org-element-type element) '(table-row item))
+ (1+ (org-element-property :begin element))
+ (org-element-property :begin element))))))
+ (unless (and (eq (org-element-type real-element) (org-element-type element))
+ (eq (org-element-property :begin real-element) (org-element-property :begin element))
+ (eq (org-element-property :end real-element) (org-element-property :end element))
+ (eq (org-element-property :contents-begin real-element) (org-element-property :contents-begin element))
+ (eq (org-element-property :contents-end real-element) (org-element-property :contents-end element))
+ (or (not (org-element-property :ID real-element))
+ (string= (org-element-property :ID real-element) (org-element-property :ID element))))
+ (org-element--cache-warn "(%S) Cached element is incorrect in %s. (Cache tic up to date: %S) Resetting.\n The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S"
+ this-command
+ (buffer-name (current-buffer))
+ (if (/= org-element--cache-change-tic
+ (buffer-chars-modified-tick))
+ "no" "yes")
+ (org-element--format-element element)
+ (org-element--format-element real-element)
+ (org-element--cache-find (1- (org-element-property :begin real-element)))
+ (car (org-element--cache-find (org-element-property :begin real-element) 'both))
+ (cdr (org-element--cache-find (org-element-property :begin real-element) 'both)))
+ (org-element-cache-reset))))))
;;;; Public Functions
@@ -5941,12 +6859,18 @@ (defun org-element-cache-reset (&optional all)
buffers."
(interactive "P")
(dolist (buffer (if all (buffer-list) (list (current-buffer))))
- (with-current-buffer buffer
+ (with-current-buffer (or (buffer-base-buffer buffer) buffer)
(when (and org-element-use-cache (derived-mode-p 'org-mode))
+ (setq-local org-element--cache-change-tic (buffer-chars-modified-tick))
(setq-local org-element--cache
(avl-tree-create #'org-element--cache-compare))
- (setq-local org-element--cache-sync-keys
- (make-hash-table :weakness 'key :test #'eq))
+ (setq-local org-element--cache-size 0)
+ (when org-element-cache-persistent
+ (org-element--cache-read)
+ (add-hook 'kill-buffer-hook #'org-element--cache-write 1000 'local)
+ (add-hook 'kill-emacs-hook #'org-element-cache-gc)
+ (add-hook 'kill-emacs-hook #'org-element--cache-write-all 1000))
+ (setq-local org-element--cache-sync-keys-value (buffer-chars-modified-tick))
(setq-local org-element--cache-change-warning nil)
(setq-local org-element--cache-sync-requests nil)
(setq-local org-element--cache-sync-timer nil)
@@ -5963,8 +6887,108 @@ (defun org-element-cache-refresh (pos)
(org-element--cache-submit-request pos pos 0)
(org-element--cache-set-timer (current-buffer))))
-
\f
+
+;;;; Persistent cache
+
+(defun org-element--cache-get-cache-index ()
+ "Return plist used to store cache of the current buffer."
+ (when (and (org-element--cache-active-p)
+ (buffer-file-name))
+ (let* ((buffer-file (buffer-file-name))
+ (inode (file-attribute-inode-number (file-attributes buffer-file))))
+ (let ((result (or (seq-find (lambda (plist) (equal inode (plist-get plist :inode))) org-element-cache--index)
+ (seq-find (lambda (plist) (equal buffer-file (plist-get plist :path))) org-element-cache--index))))
+ (when result
+ (unless (equal buffer-file (plist-get result :path))
+ (setf result (plist-put result :path buffer-file))))
+ (unless result
+ (push (list :path buffer-file
+ :inode inode
+ :hash (secure-hash 'md5 (current-buffer))
+ :cache-file (replace-regexp-in-string "^.." "\\&/" (org-id-uuid)))
+ org-element-cache--index)
+ (setf result (car org-element-cache--index)))
+ result))))
+
+(defun org-element--cache-write (&optional all-buffers)
+ "Save cache in current buffer or all the buffers when AL-BUFFERS is non-nil."
+ (let ((buffer-list (if all-buffers (buffer-list) (list (current-buffer)))))
+ (dolist (buf buffer-list)
+ (with-current-buffer buf
+ (when (and (org-element--cache-active-p)
+ org-element-cache-persistent
+ (buffer-file-name)
+ (not (buffer-modified-p)))
+ (let ((index (org-element--cache-get-cache-index)))
+ (setf index (plist-put index :hash (secure-hash 'md5 (current-buffer))))
+ (unless (file-exists-p org-element-cache-path)
+ (make-directory org-element-cache-path))
+ (let ((cache org-element--cache)
+ (print-circle t)
+ (print-continuous-numbering t)
+ print-number-table)
+ (org-with-wide-buffer
+ (org-element--cache-sync (current-buffer) (point-max)))
+ (with-temp-file (file-name-concat org-element-cache-path org-element-cache-index-file)
+ (prin1 org-element-cache--index (current-buffer)))
+ (let ((file (file-name-concat org-element-cache-path (plist-get index :cache-file))))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (with-temp-file file
+ (prin1 cache (current-buffer)))))))))))
+
+(defun org-element--cache-write-all ()
+ "Write cache in all buffers."
+ (org-element--cache-write t))
+
+(defun org-element-cache-gc ()
+ "Remove cached data for not existing files."
+ (when org-element-cache-persistent
+ (let (new-index)
+ (dolist (index org-element-cache--index)
+ (let ((file (plist-get index :path))
+ (cache-file (plist-get index :cache-file)))
+ (if (file-exists-p file)
+ (push index new-index)
+ (when (file-exists-p (file-name-concat org-element-cache-path cache-file))
+ (delete-file (file-name-concat org-element-cache-path cache-file))
+ (when (directory-empty-p (file-name-directory (file-name-concat org-element-cache-path cache-file)))
+ (delete-directory (file-name-directory (file-name-concat org-element-cache-path cache-file))))))))
+ (setq org-element-cache--index (nreverse new-index)))))
+
+(defun org-element--cache-read ()
+ "Restore cache for the current buffer"
+ (when (and (org-element--cache-active-p)
+ org-element-cache-persistent
+ (buffer-file-name)
+ (not (buffer-modified-p)))
+ (unless org-element-cache--index
+ (when (file-exists-p (file-name-concat org-element-cache-path org-element-cache-index-file))
+ (with-temp-buffer
+ (insert-file-contents (file-name-concat org-element-cache-path org-element-cache-index-file))
+ (setq org-element-cache--index (read (current-buffer))))))
+ (let* ((index (org-element--cache-get-cache-index))
+ (cache-file (file-name-concat org-element-cache-path (plist-get index :cache-file)))
+ (cache nil))
+ (when (and (file-exists-p cache-file)
+ (equal (secure-hash 'md5 (current-buffer)) (plist-get index :hash)))
+ (with-temp-buffer
+ (let ((coding-system-for-read 'utf-8)
+ (read-circle t))
+ (insert-file-contents cache-file))
+ ;; FIXME: Reading sometimes fails to read circular objects.
+ ;; I suspect that it happens when we have object reference
+ ;; #N# read before object definition #N=. If it is really
+ ;; #so, it should be Emacs bug - either in `read' or in
+ ;; #`prin1'. Meanwhile, just fail silently when `read'
+ ;; #fails to parse the saved cache object.
+ (condition-case nil
+ (setq cache (read (current-buffer)))
+ (error (setq cache nil))))
+ (setq-local org-element--cache cache)
+ (setq-local org-element--cache-size (avl-tree-size org-element--cache))))))
+
;;; The Toolbox
;;
;; The first move is to implement a way to obtain the smallest element
@@ -5983,8 +7007,11 @@ ;;; The Toolbox
;;;###autoload
-(defun org-element-at-point ()
- "Determine closest element around point.
+(defun org-element-at-point (&optional pom cached-only)
+ "Determine closest element around point or POM.
+
+Only check cached element when CACHED-ONLY is non-nil and return nil
+unconditionally when element at POM is not in cache.
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element and PROPS a plist of properties associated to the
@@ -6002,24 +7029,61 @@ (defun org-element-at-point ()
When point is at the end of the buffer, return the innermost
element ending there."
- (org-with-wide-buffer
- (let ((origin (point)))
- (end-of-line)
- (skip-chars-backward " \r\t\n")
- (cond
- ;; Within blank lines at the beginning of buffer, return nil.
- ((bobp) nil)
- ;; Within blank lines right after a headline, return that
- ;; headline.
- ((org-with-limited-levels (org-at-heading-p))
- (beginning-of-line)
- (org-element-headline-parser (point-max) t))
- ;; Otherwise parse until we find element containing ORIGIN.
- (t
- (when (org-element--cache-active-p)
- (if (not org-element--cache) (org-element-cache-reset)
- (org-element--cache-sync (current-buffer) origin)))
- (org-element--parse-to origin))))))
+ (setq pom (or pom (point)))
+ ;; Allow re-parsing when the command can benefit from it.
+ (when (and cached-only
+ (memq this-command org-element--cache-non-modifying-commands))
+ (setq cached-only nil))
+ (let (element)
+ (when (org-element--cache-active-p)
+ (if (not org-element--cache) (org-element-cache-reset)
+ (unless cached-only (org-element--cache-sync (current-buffer) pom))))
+ (setq element (if cached-only
+ (and (org-element--cache-active-p)
+ (or (not org-element--cache-sync-requests)
+ (org-element--cache-key-less-p pom (org-element--request-key (car org-element--cache-sync-requests))))
+ (org-element--cache-find pom))
+ (condition-case err
+ (org-element--parse-to pom)
+ (error
+ (org-element--cache-warn "Cache corruption detected in %s. Resetting.\n The error was: %S"
+ (buffer-name (current-buffer))
+ err)
+ (org-element-cache-reset)
+ (org-element--parse-to pom)))))
+ (when (and (org-element--cache-active-p)
+ element
+ (org-element--cache-verify-element element))
+ (setq element (org-element--parse-to pom)))
+ (unless (eq 'org-data (org-element-type element))
+ (unless (and cached-only
+ (not (and element
+ (or (= pom (org-element-property :begin element))
+ (and (not (memq (org-element-type element) org-element-greater-elements))
+ (>= pom (org-element-property :begin element))
+ (< pom (org-element-property :end element)))
+ (and (org-element-property :contents-begin element)
+ (>= pom (org-element-property :begin element))
+ (< pom (org-element-property :contents-begin element)))
+ (and (org-element-property :contents-end element)
+ (< pom (org-element-property :end element))
+ (>= pom (org-element-property :contents-end element)))
+ (and (not (org-element-property :contents-end element))
+ (>= pom (org-element-property :begin element))
+ (< pom (org-element-property :end element)))))))
+ (if (not (eq (org-element-type element) 'section))
+ element
+ (org-element-at-point (1+ pom) cached-only))))))
+
+;;;###autoload
+(defsubst org-element-at-point-no-context (&optional pom)
+ "Quickly find element at point or POM.
+
+It is a faster version of `org-element-at-point' that is not
+guaranteed to return correct `:parent' properties even when cache is
+enabled."
+ (or (org-element-at-point pom 'cached-only)
+ (let (org-element-use-cache) (org-element-at-point pom))))
;;;###autoload
(defun org-element-context (&optional element)
@@ -6043,7 +7107,7 @@ (defun org-element-context (&optional element)
(catch 'objects-forbidden
(org-with-wide-buffer
(let* ((pos (point))
- (element (or element (org-element-at-point)))
+ (element (or element (org-element-at-point-no-context)))
(type (org-element-type element))
(post (org-element-property :post-affiliated element)))
;; If point is inside an element containing objects or
^ permalink raw reply related [flat|nested] 12+ messages in thread* Re: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
2021-09-19 7:30 [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost Ihor Radchenko
@ 2021-09-19 9:58 ` Timothy
2021-09-19 11:18 ` Ihor Radchenko
0 siblings, 1 reply; 12+ messages in thread
From: Timothy @ 2021-09-19 9:58 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 1125 bytes --]
Hi Ihor,
I’ve just read through your description, and this sounds very promising! Many
thanks for going to the effort of tracking down this performance issue and
/actually making a patch to address it/.
As someone who tangles massive literate config this sounds like it could make
quite a noticeable improvement. To test this, do I need to do anything more than
just apply your patch?
> I would like to propose adding support of storing headlines in
> org-element-cache.
>
> Currently, org-element-cache only stores elements within individual
> sections. Storing headlines in cache would open various possibilities to
> improve Org performance: tag inheritance, property inheritance, category
> queries, id lookup, refile targets, agenda views, etc could all make use
> of cache.
>
> I am not proposing a mere idea, but have an actual working (WIP) code
> in: <https://github.com/yantar92/org>. Also, I am attaching a reference
> patch for org-element.el (the actual branch contains more changes).
All the best,
Timothy
p.s. I’m marking this as a patch on the tracker, since it is one :P
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
2021-09-19 9:58 ` Timothy
@ 2021-09-19 11:18 ` Ihor Radchenko
2021-09-19 12:39 ` Timothy
0 siblings, 1 reply; 12+ messages in thread
From: Ihor Radchenko @ 2021-09-19 11:18 UTC (permalink / raw)
To: Timothy; +Cc: emacs-orgmode
Timothy <tecosaur@gmail.com> writes:
> p.s. I’m marking this as a patch on the tracker, since it is one :P
This is not a real patch. I just separated changes I made in
org-element.el. Other changes include cache support across Org code and
tests. In total it looks roughly like:
12 files changed, 2584 insertions(+), 1140 deletions(-)
However, I did not directly base the patch on master, but rather on
(hopefully-to-be-merged-at-some-point org-fold branch :'/). I am not too
interested in porting the patch onto master. At least not until I get
feedback on parser and API changes.
> As someone who tangles massive literate config this sounds like it could make
> quite a noticeable improvement. To test this, do I need to do anything more than
> just apply your patch?
Applying the patch will not work. As I said, it is mostly for reference
to show the changes to parser and API. If you want to test it, you can
use https://github.com/yantar92/org. That repo includes the org-fold
branch and the new cache implementation.
Best,
Ihor
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
2021-09-19 11:18 ` Ihor Radchenko
@ 2021-09-19 12:39 ` Timothy
2021-09-19 12:52 ` Ihor Radchenko
0 siblings, 1 reply; 12+ messages in thread
From: Timothy @ 2021-09-19 12:39 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 1410 bytes --]
Hi Ihor,
Thanks for clearing up the nature of your patch-y feature request.
>> p.s. I’m marking this as a patch on the tracker, since it is one :P
>
> This is not a real patch. I just separated changes I made in
> org-element.el. Other changes include cache support across Org code and
> tests. In total it looks roughly like:
>
> 12 files changed, 2584 insertions(+), 1140 deletions(-)
>
> However, I did not directly base the patch on master, but rather on
> (hopefully-to-be-merged-at-some-point org-fold branch :’/). I am not too
> interested in porting the patch onto master. At least not until I get
> feedback on parser and API changes.
Righteo, I’ll un-mark this as a patch then 🙂.
>> As someone who tangles massive literate config this sounds like it could make
>> quite a noticeable improvement. To test this, do I need to do anything more than
>> just apply your patch?
>
> Applying the patch will not work. As I said, it is mostly for reference
> to show the changes to parser and API. If you want to test it, you can
> use <https://github.com/yantar92/org>. That repo includes the org-fold
> branch and the new cache implementation.
Ah, I’ve already got a few patches on Org that I’m preparing for sharing on the
ML, so this may make it a bit harder for me. I’ll let you know how I find it if
I do give it a go though.
All the best,
Timothy
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
2021-09-19 12:39 ` Timothy
@ 2021-09-19 12:52 ` Ihor Radchenko
2021-09-25 14:51 ` Bastien
0 siblings, 1 reply; 12+ messages in thread
From: Ihor Radchenko @ 2021-09-19 12:52 UTC (permalink / raw)
To: Timothy; +Cc: emacs-orgmode
Timothy <tecosaur@gmail.com> writes:
> Ah, I’ve already got a few patches on Org that I’m preparing for sharing on the
> ML, so this may make it a bit harder for me. I’ll let you know how I find it if
> I do give it a go though.
My repo is up-to-date with latest master. You should be able to merge
without too much trouble. I think you can even add my repo to git
remotes, fetch feature/org-fold-universal-core branch, and merge it with
your local testing branch.
Best,
Ihor
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
2021-09-19 12:52 ` Ihor Radchenko
@ 2021-09-25 14:51 ` Bastien
2021-10-17 6:56 ` Ihor Radchenko
2021-10-17 6:57 ` Ihor Radchenko
0 siblings, 2 replies; 12+ messages in thread
From: Bastien @ 2021-09-25 14:51 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-orgmode, Timothy
Hi Ihor,
Ihor Radchenko <yantar92@gmail.com> writes:
> Timothy <tecosaur@gmail.com> writes:
>> Ah, I’ve already got a few patches on Org that I’m preparing for sharing on the
>> ML, so this may make it a bit harder for me. I’ll let you know how I find it if
>> I do give it a go though.
>
> My repo is up-to-date with latest master.
If you feel confident the change is mature enough for being merged
into the main branch, please go ahead, this will boost the feedback.
Thanks!
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
2021-09-25 14:51 ` Bastien
@ 2021-10-17 6:56 ` Ihor Radchenko
2021-10-18 5:07 ` Bastien
2021-10-17 6:57 ` Ihor Radchenko
1 sibling, 1 reply; 12+ messages in thread
From: Ihor Radchenko @ 2021-10-17 6:56 UTC (permalink / raw)
To: Bastien; +Cc: emacs-orgmode, Timothy
Bastien <bzg@gnu.org> writes:
> If you feel confident the change is mature enough for being merged
> into the main branch, please go ahead, this will boost the feedback.
Merged to main just now.
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
2021-09-25 14:51 ` Bastien
2021-10-17 6:56 ` Ihor Radchenko
@ 2021-10-17 6:57 ` Ihor Radchenko
2021-10-18 7:47 ` Bastien
1 sibling, 1 reply; 12+ messages in thread
From: Ihor Radchenko @ 2021-10-17 6:57 UTC (permalink / raw)
To: Bastien; +Cc: emacs-orgmode, Timothy
Bastien <bzg@gnu.org> writes:
> If you feel confident the change is mature enough for being merged
> into the main branch, please go ahead, this will boost the feedback.
Merged to main just now.
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
2021-10-17 6:57 ` Ihor Radchenko
@ 2021-10-18 7:47 ` Bastien
2021-10-18 8:10 ` Ihor Radchenko
0 siblings, 1 reply; 12+ messages in thread
From: Bastien @ 2021-10-18 7:47 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: emacs-orgmode, Timothy
Hi Ihor,
Ihor Radchenko <yantar92@gmail.com> writes:
> Bastien <bzg@gnu.org> writes:
>
>> If you feel confident the change is mature enough for being merged
>> into the main branch, please go ahead, this will boost the feedback.
>
> Merged to main just now.
with latest main, I cannot use S-<right> (org-agenda-do-date-later) to
update the entry at point.
Here is the backtrace I get:
Debugger entered--Lisp error: (error "Cannot find time stamp")
error("Cannot find time stamp")
(if (org-at-timestamp-p 'lax) nil (error "Cannot find time stamp"))
(save-current-buffer (set-buffer buffer) (widen) (goto-char pos) (if
(org-at-timestamp-p 'lax) nil (error "Cannot find time stamp")) (if
(and org-agenda-move-date-from-past-immediately-to-today (equal arg
1) (or (not what) (eq what 'day)) (not (let
((save-match-data-internal (match-data))) (unwind-protect (progn
(org-at-date-range-p)) (set-match-data save-match-data-internal
'evaporate))))) (progn (setq cdate (org-parse-time-string
(match-string 0) 'nodefault) cdate (calendar-absolute-from-gregorian
(list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate))) today (org-today))
(if (> today cdate) (progn (setq arg (- today cdate))))))
(org-timestamp-change arg (or what 'day)) (if (and
(org-at-date-range-p) (re-search-backward org-tr-regexp-both
(point-at-bol))) (progn (let ((end org-last-changed-timestamp))
(org-timestamp-change arg (or what 'day)) (setq
org-last-changed-timestamp (concat org-last-changed-timestamp "--"
end))))))
Let me know if I need to investigate more.
Thanks!
--
Bastien
^ permalink raw reply [flat|nested] 12+ messages in thread* Re: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost
2021-10-18 7:47 ` Bastien
@ 2021-10-18 8:10 ` Ihor Radchenko
2021-10-18 9:25 ` Bastien
0 siblings, 1 reply; 12+ messages in thread
From: Ihor Radchenko @ 2021-10-18 8:10 UTC (permalink / raw)
To: Bastien; +Cc: emacs-orgmode, Timothy
Bastien <bzg@gnu.org> writes:
> with latest main, I cannot use S-<right> (org-agenda-do-date-later) to
> update the entry at point.
>
> Here is the backtrace I get:
>
> Debugger entered--Lisp error: (error "Cannot find time stamp")
> error("Cannot find time stamp")
Apparently 'org-marker property must always point to the beginning of
timestamp. Fixed in latest main.
Best,
Ihor
^ permalink raw reply [flat|nested] 12+ messages in thread
end of thread, other threads:[~2021-10-18 9:27 UTC | newest]
Thread overview: 12+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-09-19 7:30 [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost Ihor Radchenko
2021-09-19 9:58 ` Timothy
2021-09-19 11:18 ` Ihor Radchenko
2021-09-19 12:39 ` Timothy
2021-09-19 12:52 ` Ihor Radchenko
2021-09-25 14:51 ` Bastien
2021-10-17 6:56 ` Ihor Radchenko
2021-10-18 5:07 ` Bastien
2021-10-17 6:57 ` Ihor Radchenko
2021-10-18 7:47 ` Bastien
2021-10-18 8:10 ` Ihor Radchenko
2021-10-18 9:25 ` Bastien
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.