* [RFC] Simple cache mechanism for `org-element-at-point'
@ 2013-10-03 21:18 Nicolas Goaziou
2013-10-04 5:43 ` Eric Abrahamsen
` (2 more replies)
0 siblings, 3 replies; 9+ messages in thread
From: Nicolas Goaziou @ 2013-10-03 21:18 UTC (permalink / raw)
To: Org Mode List
[-- Attachment #1: Type: text/plain, Size: 893 bytes --]
Hello,
The following patches introduce a simple cache mechanism for both
`org-element-at-point' and `org-element-context'. My goal is to make
them fast enough to be used in most core commands (excepted
headlines-only commands).
Since a wrong cache can break Org behaviour badly, I would appreciate if
it could be tested a bit. You can disable cache at any time by setting
`org-element-use-cache' to nil and reset it with
`org-element-cache-reset' function.
It may also be interesting to tweak `org-element--cache-sync-idle-time'
and `org-element--cache-merge-changes-threshold', although I don't
expect a regular user to do it. Anyway, it may lead to better default
values.
Since cache is updated upon buffer modification, visibility status
cannot be cached properly. Since it is also buggy, the first patch
removes that data altogether.
Feedback welcome.
Regards,
--
Nicolas Goaziou
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-org-element-Remove-folding-status-in-parsed-data.patch --]
[-- Type: text/x-diff, Size: 24993 bytes --]
From 2a362b5785c4391d7df427ef9f9b64e74122316b Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <n.goaziou@gmail.com>
Date: Thu, 3 Oct 2013 22:57:02 +0200
Subject: [PATCH 1/2] org-element: Remove folding status in parsed data
* lisp/org-element.el (org-element-center-block-parser,
org-element-drawer-parser, org-element-dynamic-block-parser,
org-element-item-parser, org-element-quote-block-parser,
org-element-comment-block-parser, org-element-export-block-parser,
org-element-verse-block-parser, org-element-special-block-parser,
org-element-example-block-parser, org-element-headline-parser,
org-element-inlinetask-parser): Remove :hiddenp property.
* lisp/org.el (org-end-of-line, org-down-element): Use an equivalent
of :hiddenp property.
* testing/lisp/test-org-element.el: Remove tests.
The property is removed because it is buggy (e.g., when there's a link
just after a block opening line). Also, folding status cannot be
cached since it doesn't trigger a buffer change.
---
lisp/org-element.el | 101 +++++++++++++--------------------------
lisp/org.el | 4 +-
testing/lisp/test-org-element.el | 93 ++++-------------------------------
3 files changed, 44 insertions(+), 154 deletions(-)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 807fdb4..ef3eb46 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -493,8 +493,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `center-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -510,7 +510,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -521,7 +520,6 @@ Assume point is at the beginning of the block."
(nconc
(list :begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -545,7 +543,7 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `drawer' and CDR is a plist containing
-`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
+`:drawer-name', `:begin', `:end', `:contents-begin',
`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of drawer."
@@ -564,7 +562,6 @@ Assume point is at beginning of drawer."
(and (< (point) drawer-end-line)
(point))))
(contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char drawer-end-line)
(forward-line)
(point)))
@@ -576,7 +573,6 @@ Assume point is at beginning of drawer."
(list :begin begin
:end end
:drawer-name name
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -602,9 +598,9 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `dynamic-block' and CDR is a plist
-containing `:block-name', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:arguments', `:post-blank'
-and `:post-affiliated' keywords.
+containing `:block-name', `:begin', `:end', `:contents-begin',
+`:contents-end', `:arguments', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at beginning of dynamic block."
(let ((case-fold-search t))
@@ -624,7 +620,6 @@ Assume point is at beginning of dynamic block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -637,7 +632,6 @@ Assume point is at beginning of dynamic block."
:end end
:block-name name
:arguments arguments
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -720,11 +714,10 @@ CONTENTS is the contents of the footnote-definition."
Return a list whose CAR is `headline' and CDR is a plist
containing `:raw-value', `:title', `:alt-title', `:begin',
-`:end', `:pre-blank', `:hiddenp', `:contents-begin' and
-`:contents-end', `:level', `:priority', `:tags',
-`:todo-keyword',`:todo-type', `:scheduled', `:deadline',
-`:closed', `:quotedp', `:archivedp', `:commentedp' and
-`:footnote-section-p' keywords.
+`:end', `:pre-blank', `:contents-begin' and `:contents-end',
+`:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
+`:scheduled', `:deadline', `:closed', `:quotedp', `:archivedp',
+`:commentedp' and `:footnote-section-p' keywords.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
@@ -791,7 +784,6 @@ Assume point is at beginning of the headline."
(contents-begin (save-excursion
(skip-chars-forward " \r\t\n" end)
(and (/= (point) end) (line-beginning-position))))
- (hidden (org-invisible-p2))
(contents-end (and contents-begin
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
@@ -818,7 +810,6 @@ Assume point is at beginning of the headline."
:pre-blank
(if (not contents-begin) 0
(count-lines pos-after-head contents-begin))
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:level level
@@ -904,10 +895,10 @@ CONTENTS is the contents of the element."
"Parse an inline task.
Return a list whose CAR is `inlinetask' and CDR is a plist
-containing `:title', `:begin', `:end', `:hiddenp',
-`:contents-begin' and `:contents-end', `:level', `:priority',
-`:raw-value', `:tags', `:todo-keyword', `:todo-type',
-`:scheduled', `:deadline', `:closed' and `:post-blank' keywords.
+containing `:title', `:begin', `:end', `:contents-begin' and
+`:contents-end', `:level', `:priority', `:raw-value', `:tags',
+`:todo-keyword', `:todo-type', `:scheduled', `:deadline',
+`:closed' and `:post-blank' keywords.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
@@ -965,7 +956,6 @@ Assume point is at beginning of the inline task."
(match-beginning 0))))
(contents-begin (progn (forward-line)
(and task-end (< (point) task-end) (point))))
- (hidden (and contents-begin (org-invisible-p2)))
(contents-end (and contents-begin task-end))
(before-blank (if (not task-end) (point)
(goto-char task-end)
@@ -980,7 +970,6 @@ Assume point is at beginning of the inline task."
(list :raw-value raw-value
:begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:level (nth 1 components)
@@ -1047,8 +1036,8 @@ STRUCT is the structure of the plain list.
Return a list whose CAR is `item' and CDR is a plist containing
`:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
-`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
-`:post-blank' keywords.
+`:checkbox', `:counter', `:tag', `:structure' and `:post-blank'
+keywords.
When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
any, will not be parsed as a secondary string, but as a plain
@@ -1088,8 +1077,6 @@ Assume point is at the beginning of the item."
;; If first line isn't empty, contents really start
;; at the text after item's meta-data.
(if (= (point-at-bol) begin) (point) (point-at-bol))))
- (hidden (progn (forward-line)
- (and (not (= (point) end)) (org-invisible-p2))))
(contents-end (progn (goto-char end)
(skip-chars-backward " \r\t\n")
(forward-line)
@@ -1108,7 +1095,6 @@ Assume point is at the beginning of the item."
:contents-end (max contents-begin contents-end)
:checkbox checkbox
:counter counter
- :hiddenp hidden
:structure struct
:post-blank (count-lines contents-end end)))))
(org-element-put-property
@@ -1299,8 +1285,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `property-drawer' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the property drawer."
(save-excursion
@@ -1317,7 +1303,6 @@ Assume point is at the beginning of the property drawer."
(and (< (point) drawer-end-line)
(point))))
(contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char drawer-end-line)
(forward-line)
(point)))
@@ -1328,7 +1313,6 @@ Assume point is at the beginning of the property drawer."
(nconc
(list :begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -1352,8 +1336,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `quote-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -1370,7 +1354,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -1381,7 +1364,6 @@ Assume point is at the beginning of the block."
(nconc
(list :begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -1437,9 +1419,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `special-block' and CDR is a plist
-containing `:type', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:post-blank' and
-`:post-affiliated' keywords.
+containing `:type', `:begin', `:end', `:contents-begin',
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let* ((case-fold-search t)
@@ -1460,7 +1441,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -1472,7 +1452,6 @@ Assume point is at the beginning of the block."
(list :type type
:begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -1660,8 +1639,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `comment-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:value', `:post-blank'
-and `:post-affiliated' keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at comment block beginning."
(let ((case-fold-search t))
@@ -1674,7 +1653,6 @@ Assume point is at comment block beginning."
(let* ((begin (car affiliated))
(post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1688,7 +1666,6 @@ Assume point is at comment block beginning."
(list :begin begin
:end end
:value value
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -1778,9 +1755,8 @@ their value.
Return a list whose CAR is `example-block' and CDR is a plist
containing `:begin', `:end', `:number-lines', `:preserve-indent',
-`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
-`:switches', `:value', `:post-blank' and `:post-affiliated'
-keywords."
+`:retain-labels', `:use-labels', `:label-fmt', `:switches',
+`:value', `:post-blank' and `:post-affiliated' keywords."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
@@ -1821,7 +1797,6 @@ keywords."
(post-affiliated (point))
(block-ind (progn (skip-chars-forward " \t") (current-column)))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
(value (org-element--remove-indentation
(org-unescape-code-in-string
(buffer-substring-no-properties
@@ -1844,7 +1819,6 @@ keywords."
:retain-labels retain-labels
:use-labels use-labels
:label-fmt label-fmt
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -1870,8 +1844,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `export-block' and CDR is a plist
-containing `:begin', `:end', `:type', `:hiddenp', `:value',
-`:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:type', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at export-block beginning."
(let* ((case-fold-search t)
@@ -1887,7 +1861,6 @@ Assume point is at export-block beginning."
(let* ((begin (car affiliated))
(post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1902,7 +1875,6 @@ Assume point is at export-block beginning."
:end end
:type type
:value value
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -2325,9 +2297,9 @@ their value.
Return a list whose CAR is `src-block' and CDR is a plist
containing `:language', `:switches', `:parameters', `:begin',
-`:end', `:hiddenp', `:number-lines', `:retain-labels',
-`:use-labels', `:label-fmt', `:preserve-indent', `:value',
-`:post-blank' and `:post-affiliated' keywords.
+`:end', `:number-lines', `:retain-labels', `:use-labels',
+`:label-fmt', `:preserve-indent', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -2378,13 +2350,11 @@ Assume point is at the beginning of the block."
(not (string-match "-k\\>" switches)))))
;; Indentation.
(block-ind (progn (skip-chars-forward " \t") (current-column)))
- ;; Get visibility status.
- (hidden (progn (forward-line) (org-invisible-p2)))
;; Retrieve code.
(value (org-element--remove-indentation
(org-unescape-code-in-string
(buffer-substring-no-properties
- (point) contents-end))
+ (progn (forward-line) (point)) contents-end))
(and preserve-indent block-ind)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
@@ -2407,7 +2377,6 @@ Assume point is at the beginning of the block."
:retain-labels retain-labels
:use-labels use-labels
:label-fmt label-fmt
- :hiddenp hidden
:value value
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
@@ -2552,7 +2521,7 @@ their value.
Return a list whose CAR is `verse-block' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:hiddenp', `:post-blank' and `:post-affiliated' keywords.
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of the block."
(let ((case-fold-search t))
@@ -2564,8 +2533,7 @@ Assume point is at beginning of the block."
(save-excursion
(let* ((begin (car affiliated))
(post-affiliated (point))
- (hidden (progn (forward-line) (org-invisible-p2)))
- (contents-begin (point))
+ (contents-begin (progn (forward-line) (point)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -2578,7 +2546,6 @@ Assume point is at beginning of the block."
:end end
:contents-begin contents-begin
:contents-end contents-end
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
diff --git a/lisp/org.el b/lisp/org.el
index 5ff9969..dc869ab 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -22810,7 +22810,7 @@ the cursor is already beyond the end of the headline."
(goto-char (match-end 0))
(goto-char (match-beginning 1))))
(call-interactively move-fun))))
- ((org-element-property :hiddenp element)
+ ((outline-invisible-p (line-end-position))
;; If element is hidden, `move-end-of-line' would put point
;; after it. Use `end-of-line' to stay on current line.
(call-interactively 'end-of-line))
@@ -23511,7 +23511,7 @@ Move to the previous element at the same level, when possible."
(forward-char))
((memq (org-element-type element) org-element-greater-elements)
;; If contents are hidden, first disclose them.
- (when (org-element-property :hiddenp element) (org-cycle))
+ (when (outline-invisible-p (line-end-position)) (org-cycle))
(goto-char (or (org-element-property :contents-begin element)
(user-error "No content for this element"))))
(t (user-error "No inner element")))))
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index ea4f649..ce9803f 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -273,14 +273,6 @@ Some other text
(should
(org-test-with-temp-text "#+begin_center\nText\n#+end_center"
(org-element-map (org-element-parse-buffer) 'center-block 'identity)))
- ;; Test folded block.
- (org-test-with-temp-text "#+BEGIN_CENTER\nText\n#+END_CENTER"
- (org-cycle)
- (should
- (org-element-property
- :hiddenp
- (org-element-map
- (org-element-parse-buffer) 'center-block 'identity nil t))))
;; Ignore incomplete block.
(should-not
(org-test-with-temp-text "#+BEGIN_CENTER"
@@ -393,14 +385,6 @@ Some other text
(org-test-with-temp-text "#+begin_comment\nText\n#+end_comment"
(org-element-map
(org-element-parse-buffer) 'comment-block 'identity)))
- ;; Test folded block.
- (org-test-with-temp-text "#+BEGIN_COMMENT\nText\n#+END_COMMENT"
- (org-cycle)
- (should
- (org-element-property
- :hiddenp
- (org-element-map
- (org-element-parse-buffer) 'comment-block 'identity nil t))))
;; Ignore incomplete block.
(should-not
(org-test-with-temp-text "#+BEGIN_COMMENT"
@@ -457,15 +441,6 @@ Some other text
(org-test-with-temp-text
"#+BEGIN: myblock :param1 val1 :param2 val2\nText\n#+END:"
(org-element-map (org-element-parse-buffer) 'dynamic-block 'identity)))
- ;; Folded view
- (org-test-with-temp-text
- "#+BEGIN: myblock :param1 val1 :param2 val2\nText\n#+END:"
- (org-cycle)
- (should
- (org-element-property
- :hiddenp
- (org-element-map
- (org-element-parse-buffer) 'dynamic-block 'identity nil t))))
;; Ignore case.
(should
(org-test-with-temp-text
@@ -518,11 +493,6 @@ Some other text
(should
(org-test-with-temp-text "#+BEGIN_EXAMPLE\nText\n#+END_EXAMPLE"
(org-element-map (org-element-parse-buffer) 'example-block 'identity)))
- ;; Test folded block.
- (should
- (org-test-with-temp-text "#+BEGIN_EXAMPLE\nText\n#+END_EXAMPLE"
- (org-cycle)
- (org-element-property :hiddenp (org-element-at-point))))
;; Ignore incomplete block.
(should-not
(eq 'example-block
@@ -682,17 +652,6 @@ Some other text
'(("LATEX" . org-element-export-block-parser))))
(org-element-parse-buffer))
'export-block 'identity)))
- ;; Test folded block.
- (org-test-with-temp-text "#+BEGIN_LATEX\nText\n#+END_LATEX"
- (org-cycle)
- (should
- (org-element-property
- :hiddenp
- (org-element-map
- (let ((org-element-block-name-alist
- '(("LATEX" . org-element-export-block-parser))))
- (org-element-parse-buffer))
- 'export-block 'identity nil t))))
;; Ignore case.
(should
(org-test-with-temp-text "#+begin_latex\nText\n#+end_latex"
@@ -1111,17 +1070,6 @@ DEADLINE: <2012-03-29 thu.>"
(org-element-map
(org-element-parse-buffer) 'item
(lambda (item) (org-element-property :checkbox item))))))
- ;; Folded state.
- (org-test-with-temp-text "* Headline
-- item
-
- paragraph below"
- (forward-line)
- (let ((org-cycle-include-plain-lists t)) (org-cycle))
- (should
- (org-element-property
- :hiddenp
- (org-element-map (org-element-parse-buffer) 'item 'identity nil t))))
;; Item starting with special syntax.
(should
(equal '(("- item"))
@@ -1592,14 +1540,6 @@ Outside list"
(should
(org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE"
(org-element-map (org-element-parse-buffer) 'quote-block 'identity)))
- ;; Test folded block.
- (org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE"
- (org-cycle)
- (should
- (org-element-property
- :hiddenp
- (org-element-map
- (org-element-parse-buffer) 'quote-block 'identity nil t))))
;; Ignore incomplete block.
(should-not
(org-test-with-temp-text "#+BEGIN_QUOTE"
@@ -1674,11 +1614,6 @@ Outside list"
(org-test-with-temp-text "#+BEGIN_SPECIAL\nText\n#+END_SPECIAL"
(forward-line)
(org-element-type (org-element-at-point)))))
- ;; Test folded block.
- (should
- (org-test-with-temp-text "#+BEGIN_SPECIAL\nText\n#+END_SPECIAL"
- (org-cycle)
- (org-element-property :hiddenp (org-element-at-point))))
;; Ignore incomplete block.
(should-not
(eq 'special-block
@@ -1701,11 +1636,6 @@ Outside list"
(should
(org-test-with-temp-text "#+BEGIN_SRC org\nText\n#+END_SRC"
(org-element-map (org-element-parse-buffer) 'src-block 'identity)))
- ;; Test folded block.
- (should
- (org-test-with-temp-text "#+BEGIN_SRC org\nText\n#+END_SRC"
- (org-cycle)
- (org-element-property :hiddenp (org-element-at-point))))
;; Ignore incomplete block.
(should-not
(org-test-with-temp-text "#+BEGIN_SRC"
@@ -1978,29 +1908,22 @@ Outside list"
(ert-deftest test-org-element/verse-block-parser ()
"Test `verse-block' parser."
;; Standard test.
- (org-test-with-temp-text "#+BEGIN_VERSE\nVerse block\n#+END_VERSE"
- (should
+ (should
+ (org-test-with-temp-text "#+BEGIN_VERSE\nVerse block\n#+END_VERSE"
(org-element-map (org-element-parse-buffer) 'verse-block 'identity)))
;; Ignore case.
- (org-test-with-temp-text "#+begin_verse\nVerse block\n#+end_verse"
- (should
+ (should
+ (org-test-with-temp-text "#+begin_verse\nVerse block\n#+end_verse"
(org-element-map (org-element-parse-buffer) 'verse-block 'identity)))
- ;; Parse folding.
- (org-test-with-temp-text "#+BEGIN_VERSE\nVerse block\n#+END_VERSE"
- (org-hide-block-all)
- (should
- (org-element-property
- :hiddenp
- (org-element-map
- (org-element-parse-buffer) 'verse-block 'identity nil t))))
;; Parse objects in verse blocks.
- (org-test-with-temp-text "#+BEGIN_VERSE\nVerse \\alpha\n#+END_VERSE"
- (should (org-element-map (org-element-parse-buffer) 'entity 'identity)))
+ (should
+ (org-test-with-temp-text "#+BEGIN_VERSE\nVerse \\alpha\n#+END_VERSE"
+ (org-element-map (org-element-parse-buffer) 'entity 'identity)))
;; Ignore incomplete verse block.
(should-not
(org-test-with-temp-text "#+BEGIN_VERSE"
(org-element-map
- (org-element-parse-buffer) 'verse-block 'identity nil t))))
+ (org-element-parse-buffer) 'verse-block 'identity nil t))))
\f
--
1.8.4
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-org-element-Implement-caching-for-dynamic-parser.patch --]
[-- Type: text/x-diff, Size: 36972 bytes --]
From 41df6d5257f516e45cba1360ea47bd6522bf6a5c Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <n.goaziou@gmail.com>
Date: Thu, 3 Oct 2013 22:12:35 +0200
Subject: [PATCH 2/2] org-element: Implement caching for dynamic parser
* lisp/org-element.el (org-element-use-cache, org-element--cache,
org-element--cache-sync-idle-time,
org-element--cache-merge-changes-threshold, org-element--cache-status,
org-element--cache-opening-line, org-element--cache-closing-line): New
variables.
(org-element-cache-reset, org-element--cache-pending-changes-p,
org-element--cache-push-change, org-element--cache-cancel-changes,
org-element--cache-get-key, org-element-cache-get,
org-element-cache-put, org-element--shift-positions,
org-element--cache-before-change, org-element--cache-record-change,
org-element--cache-sync): New functions.
(org-element-at-point, org-element-context): Use cache when possible.
* testing/lisp/test-org-element.el: Update tests.
This patch gives a boost to `org-element-at-point' and, to a lesser
extent, to `org-element-context'.
---
lisp/org-element.el | 740 ++++++++++++++++++++++++++++++++-------
testing/lisp/test-org-element.el | 18 +-
2 files changed, 618 insertions(+), 140 deletions(-)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index ef3eb46..084f57c 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -111,7 +111,8 @@
;;
;; The library ends by furnishing `org-element-at-point' function, and
;; a way to give information about document structure around point
-;; with `org-element-context'.
+;; with `org-element-context'. A simple cache mechanism is also
+;; provided for these functions.
;;; Code:
@@ -4642,7 +4643,7 @@ indentation is not done with TAB characters."
;; The first move is to implement a way to obtain the smallest element
;; containing point. This is the job of `org-element-at-point'. It
;; basically jumps back to the beginning of section containing point
-;; and moves, element after element, with
+;; and proceed, one element after the other, with
;; `org-element--current-element' until the container is found. Note:
;; When using `org-element-at-point', secondary values are never
;; parsed since the function focuses on elements, not on objects.
@@ -4650,8 +4651,407 @@ indentation is not done with TAB characters."
;; At a deeper level, `org-element-context' lists all elements and
;; objects containing point.
;;
-;; `org-element-nested-p' and `org-element-swap-A-B' may be used
-;; internally by navigation and manipulation tools.
+;; Both functions benefit from a simple caching mechanism. It is
+;; enabled by default, but can be disabled globally with
+;; `org-element-use-cache'. Also `org-element-cache-reset' clears or
+;; initializes cache for current buffer. Values are retrieved and put
+;; into cache with respectively, `org-element-cache-get' and
+;; `org-element-cache-put'. `org-element--cache-sync-idle-time' and
+;; `org-element--cache-merge-changes-threshold' are used internally to
+;; control caching behaviour.
+;;
+;; Eventually `org-element-nested-p' and `org-element-swap-A-B' may be
+;; used internally by navigation and manipulation tools.
+
+(defvar org-element-use-cache t
+ "Non nil when Org parser should cache its results.")
+
+(defvar org-element--cache nil
+ "Hash table used as a cache for parser.
+Key is a buffer position and value is a cons cell with the
+pattern:
+
+ \(ELEMENT . OBJECTS-DATA)
+
+where ELEMENT is the element starting at the key and OBJECTS-DATA
+is an alist where each association is:
+
+ \(POS CANDIDATES . OBJECTS)
+
+where POS is a buffer position, CANDIDATES is the last know list
+of successors (see `org-element--get-next-object-candidates') in
+container starting at POS and OBJECTS is a list of objects known
+to live within that container, from farthest to closest.
+
+In the following example, \\alpha, bold object and \\beta start
+at, respectively, positions 1, 7 and 8,
+
+ \\alpha *\\beta*
+
+If the paragraph is completely parsed, OBJECTS-DATA will be
+
+ \((1 nil BOLD-OBJECT ENTITY-OBJECT)
+ \(8 nil ENTITY-OBJECT))
+
+whereas in a partially parsed paragraph, it could be
+
+ \((1 ((entity . 1) (bold . 7)) ENTITY-OBJECT))
+
+This cache is used in both `org-element-at-point' and
+`org-element-context'. The former uses ELEMENT only and the
+latter OBJECTS-DATA only.")
+
+(defvar org-element--cache-sync-idle-time 0.5
+ "Number of seconds of idle time wait before syncing buffer cache.
+Syncing also happens when current modification is too distant
+from the stored one (for more information, see
+`org-element--cache-merge-changes-threshold').")
+
+(defvar org-element--cache-merge-changes-threshold 200
+ "Number of characters triggering cache syncing.
+
+The cache mechanism only stores one buffer modification at any
+given time. When another change happens, it replaces it with
+a change containing both the stored modification and the current
+one. This is a trade-off, as merging them prevents another
+syncing, but every element between them is then lost.
+
+This variable determines the maximum size, in characters, we
+accept to lose in order to avoid syncing the cache.")
+
+(defvar org-element--cache-status nil
+ "Contains data about cache validity for current buffer.
+
+Value is a vector of seven elements,
+
+ [ACTIVEP BEGIN END OFFSET TIMER PREVIOUS-STATE]
+
+ACTIVEP is a boolean non-nil when changes described in the other
+slots are valid for current buffer.
+
+BEGIN and END are the beginning and ending position of the area
+for which cache cannot be trusted.
+
+OFFSET it an integer specifying the number to add to position of
+elements after that area.
+
+TIMER is a timer used to apply these changes to cache when Emacs
+is idle.
+
+PREVIOUS-STATE is a symbol referring to the state of the buffer
+before a change happens. It is used to know if sensitive
+areas (block boundaries, headlines) were modified. It can be set
+to nil, `headline' or `other'.")
+
+;;;###autoload
+(defun org-element-cache-reset ()
+ "Reset cache for current buffer."
+ (when (derived-mode-p 'org-mode)
+ (if (hash-table-p org-element--cache) (clrhash org-element--cache)
+ (org-set-local 'org-element--cache
+ (make-hash-table :size 5003 :test 'eq)))
+ (org-set-local 'org-element--cache-status (make-vector 6 nil))
+ (add-hook 'before-change-functions 'org-element--cache-before-change nil t)
+ (add-hook 'after-change-functions 'org-element--cache-record-change nil t)))
+
+(defsubst org-element--cache-pending-changes-p ()
+ "Non-nil when changes are not integrated in cache yet."
+ (and org-element--cache-status
+ (aref org-element--cache-status 0)))
+
+(defsubst org-element--cache-push-change (beg end offset)
+ "Push change to current buffer staging area.
+BEG and END and the beginning and ending position of the
+modification area. OFFSET is the size of the change, as an
+integer."
+ (aset org-element--cache-status 1 beg)
+ (aset org-element--cache-status 2 end)
+ (aset org-element--cache-status 3 offset)
+ (let ((timer (aref org-element--cache-status 4)))
+ (if timer (timer-activate-when-idle timer t)
+ (aset org-element--cache-status 4
+ (run-with-idle-timer org-element--cache-sync-idle-time
+ nil
+ #'org-element--cache-sync
+ (current-buffer)))))
+ (aset org-element--cache-status 0 t))
+
+(defsubst org-element--cache-cancel-changes ()
+ "Remove any cache change set for current buffer."
+ (let ((timer (aref org-element--cache-status 4)))
+ (and timer (cancel-timer timer)))
+ (aset org-element--cache-status 0 nil))
+
+(defsubst org-element--cache-get-key (element)
+ "Return expected key for ELEMENT in cache."
+ (let ((begin (org-element-property :begin element)))
+ (if (and (memq (org-element-type element) '(item table-row))
+ (= (org-element-property :contents-begin
+ (org-element-property :parent element))
+ begin))
+ ;; Special key for first item (resp. table-row) in a plain
+ ;; list (resp. table).
+ (1+ begin)
+ begin)))
+
+(defsubst org-element-cache-get (pos &optional type)
+ "Return data stored at key POS in current buffer cache.
+When optional argument TYPE is `element', retrieve the element
+starting at POS. When it is `objects', return the list of object
+types along with their beginning position within that element.
+Otherwise, return the full data. In any case, return nil if no
+data is found, or if caching is not allowed."
+ (when (and org-element-use-cache org-element--cache)
+ ;; If there are pending changes, first sync them.
+ (when (org-element--cache-pending-changes-p)
+ (org-element--cache-sync (current-buffer)))
+ (let ((data (gethash pos org-element--cache)))
+ (case type
+ (element (car data))
+ (objects (cdr data))
+ (otherwise data)))))
+
+(defsubst org-element-cache-put (pos data)
+ "Store data in current buffer's cache, if allowed.
+POS is a buffer position, which will be used as a key. DATA is
+the value to store. Nothing will be stored if
+`org-element-use-cache' is nil. Return DATA in any case."
+ (if (not org-element-use-cache) data
+ (unless org-element--cache (org-element-cache-reset))
+ (puthash pos data org-element--cache)))
+
+(defsubst org-element--shift-positions (element offset)
+ "Shift ELEMENT properties relative to buffer positions by OFFSET.
+Properties containing buffer positions are `:begin', `:end',
+`:contents-begin', `:contents-end' and `:structure'. They are
+modified by side-effect. Return modified element."
+ (let ((properties (nth 1 element)))
+ ;; Shift :structure property for the first plain list only: it is
+ ;; the only one that really matters and it prevents from shifting
+ ;; it more than once.
+ (when (eq (car element) 'plain-list)
+ (let ((structure (plist-get properties :structure)))
+ (when (<= (plist-get properties :begin) (caar structure))
+ (dolist (item structure)
+ (incf (car item) offset)
+ (incf (nth 6 item) offset)))))
+ (plist-put properties :begin (+ (plist-get properties :begin) offset))
+ (plist-put properties :end (+ (plist-get properties :end) offset))
+ (dolist (key '(:contents-begin :contents-end :post-affiliated))
+ (let ((value (plist-get properties key)))
+ (and value (plist-put properties key (+ offset value))))))
+ element)
+
+(defconst org-element--cache-opening-line
+ (concat "^[ \t]*\\(?:"
+ "#\\+BEGIN[:_]" "\\|"
+ "\\\\begin{[A-Za-z0-9]+\\*?}" "\\|"
+ ":\\S-+:[ \t]*$"
+ "\\)")
+ "Regexp matching an element opening line.
+When such a line is modified, modifications may propagate after
+modified area. In that situation, every element between that
+area and next section is removed from cache.")
+
+(defconst org-element--cache-closing-line
+ (concat "^[ \t]*\\(?:"
+ "#\\+END\\(?:_\\|:?[ \t]*$\\)" "\\|"
+ "\\\\end{[A-Za-z0-9]+\\*?}[ \t]*$" "\\|"
+ ":END:[ \t]*$"
+ "\\)")
+ "Regexp matching an element closing line.
+When such a line is modified, modifications may propagate before
+modified area. In that situation, every element between that
+area and previous section is removed from cache.")
+
+(defun org-element--cache-before-change (beg end)
+ "Request extension of area going to be modified if needed.
+BEG and END are the beginning and end of the range of changed
+text. See `before-change-functions' for more information."
+ (let ((inhibit-quit t))
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (let ((top (point))
+ (bottom (save-excursion (goto-char end) (line-end-position)))
+ (sensitive-re
+ ;; A sensitive line is a headline or a block (or drawer,
+ ;; or latex-environment) boundary. Inserting one can
+ ;; modify buffer drastically both above and below that
+ ;; line, possibly making cache invalid. Therefore, we
+ ;; need to pay special attention to changes happening to
+ ;; them.
+ (concat
+ "\\(" (org-with-limited-levels org-outline-regexp-bol) "\\)" "\\|"
+ org-element--cache-closing-line "\\|"
+ org-element--cache-opening-line)))
+ (save-match-data
+ (aset org-element--cache-status 5
+ (cond ((not (re-search-forward sensitive-re bottom t)) nil)
+ ((and (match-beginning 1)
+ (progn (goto-char bottom)
+ (or (not (re-search-backward sensitive-re
+ (match-end 1) t))
+ (match-beginning 1))))
+ 'headline)
+ (t 'other))))))))
+
+(defun org-element--cache-record-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.
+
+If there are already pending changes, try to merge them into
+a bigger change record. If that's not possible, the function
+will first synchronize cache with previous change and store the
+new one."
+ (let ((inhibit-quit t))
+ (when (and org-element-use-cache org-element--cache)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (let ((top (point))
+ (bottom (save-excursion (goto-char end) (line-end-position))))
+ (org-with-limited-levels
+ (save-match-data
+ ;; 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 (let ((previous-state (aref org-element--cache-status 5))
+ (sensitive-re
+ (concat "\\(" org-outline-regexp-bol "\\)" "\\|"
+ org-element--cache-closing-line "\\|"
+ org-element--cache-opening-line)))
+ (cond ((eq previous-state 'other))
+ ((not (re-search-forward sensitive-re bottom t))
+ (eq previous-state 'headline))
+ ((match-beginning 1)
+ (or (not (eq previous-state 'headline))
+ (and (progn (goto-char bottom)
+ (re-search-backward
+ sensitive-re (match-end 1) t))
+ (not (match-beginning 1)))))
+ (t)))
+ ;; Effectively extend modified area.
+ (setq top (progn (goto-char top)
+ (outline-previous-heading)
+ ;; Headline above is inclusive.
+ (point)))
+ (setq bottom (progn (goto-char bottom)
+ (outline-next-heading)
+ ;; Headline below is exclusive.
+ (if (eobp) (point) (1- (point))))))))
+ ;; Store changes.
+ (let ((offset (- end beg pre)))
+ (if (not (org-element--cache-pending-changes-p))
+ ;; No pending changes. Store the new ones.
+ (org-element--cache-push-change top (- bottom offset) offset)
+ (let* ((current-start (aref org-element--cache-status 1))
+ (current-end (+ (aref org-element--cache-status 2)
+ (aref org-element--cache-status 3)))
+ (gap (max (- beg current-end) (- current-start end))))
+ (if (> gap org-element--cache-merge-changes-threshold)
+ ;; If we cannot merge two change sets (i.e. they
+ ;; modify distinct buffer parts) first apply current
+ ;; change set and store new one. This way, there is
+ ;; never more than one pending change set, which
+ ;; avoids handling costly merges.
+ (progn (org-element--cache-sync (current-buffer))
+ (org-element--cache-push-change
+ top (- bottom offset) offset))
+ ;; Change sets can be merged. We can expand the area
+ ;; that requires an update, and postpone the sync.
+ (timer-activate-when-idle (aref org-element--cache-status 4) t)
+ (aset org-element--cache-status 0 t)
+ (aset org-element--cache-status 1 (min top current-start))
+ (aset org-element--cache-status 2
+ (- (max current-end bottom) offset))
+ (incf (aref org-element--cache-status 3) offset))))))))))
+
+(defun org-element--cache-sync (buffer)
+ "Synchronize cache with recent modification in BUFFER.
+Elements ending before modification area are kept in cache.
+Elements starting after modification area have their position
+shifted by the size of the modification. Every other element is
+removed from the cache."
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (when (org-element--cache-pending-changes-p)
+ (let ((inhibit-quit t)
+ (beg (aref org-element--cache-status 1))
+ (end (aref org-element--cache-status 2))
+ (offset (aref org-element--cache-status 3))
+ new-keys)
+ (maphash
+ #'(lambda (key value)
+ (cond
+ ((memq key new-keys))
+ ((> key end)
+ ;; Shift every element starting after END by OFFSET.
+ ;; We also need to shift keys, since they refer to
+ ;; buffer positions.
+ ;;
+ ;; Upon shifting a key a conflict can occur if the
+ ;; shifted key also refers to some element in the
+ ;; cache. In this case, we temporarily associate
+ ;; both elements, as a cons cell, to the shifted key,
+ ;; following the pattern (SHIFTED . CURRENT).
+ ;;
+ ;; Such a conflict can only occur if shifted key hash
+ ;; hasn't been processed by `maphash' yet.
+ (unless (zerop offset)
+ (let* ((conflictp (consp (caar value)))
+ (value-to-shift (if conflictp (cdr value) value)))
+ ;; Shift element part.
+ (org-element--shift-positions (car value-to-shift) offset)
+ ;; Shift objects part.
+ (dolist (object-data (cdr value-to-shift))
+ (incf (car object-data) offset)
+ (dolist (successor (nth 1 object-data))
+ (incf (cdr successor) offset))
+ (dolist (object (cddr object-data))
+ (org-element--shift-positions object offset)))
+ ;; Shift key-value pair.
+ (let* ((new-key (+ key offset))
+ (new-value (gethash new-key org-element--cache)))
+ ;; Put new value to shifted key.
+ ;;
+ ;; If one already exists, do not overwrite it:
+ ;; store it as the car of a cons cell instead,
+ ;; and handle it when `maphash' reaches
+ ;; NEW-KEY.
+ ;;
+ ;; If there is no element stored at NEW-KEY or
+ ;; if NEW-KEY is going to be removed anyway
+ ;; (i.e., it is before END), just store new
+ ;; value there and make sure it will not be
+ ;; processed again by storing NEW-KEY in
+ ;; NEW-KEYS.
+ (puthash new-key
+ (if (and new-value (> new-key end))
+ (cons value-to-shift new-value)
+ (push new-key new-keys)
+ value-to-shift)
+ org-element--cache)
+ ;; If current value contains two elements, car
+ ;; should be the new value, since cdr has been
+ ;; shifted already.
+ (if conflictp
+ (puthash key (car value) org-element--cache)
+ (remhash key org-element--cache))))))
+ ;; Remove every element between BEG and END, since
+ ;; this is where changes happened.
+ ((>= key beg) (remhash key org-element--cache))
+ ;; Preserve any element ending before BEG. If it
+ ;; overlaps the BEG-END area, remove it.
+ (t (or (< (org-element-property :end (car value)) beg)
+ (remhash key org-element--cache)))))
+ org-element--cache)
+ ;; Signal cache as up-to-date.
+ (org-element--cache-cancel-changes))))))
;;;###autoload
(defun org-element-at-point (&optional keep-trail)
@@ -4683,96 +5083,124 @@ first element of current section."
(if (org-with-limited-levels (org-at-heading-p))
(progn
(beginning-of-line)
- (if (not keep-trail) (org-element-headline-parser (point-max) t)
- (list (org-element-headline-parser (point-max) t))))
+ (let ((headline
+ (or (org-element-cache-get (point) 'element)
+ (car (org-element-cache-put
+ (point)
+ (list (org-element-headline-parser
+ (point-max) t)))))))
+ (if keep-trail (list headline) headline)))
;; Otherwise move at the beginning of the section containing
;; point.
(catch 'exit
- (let ((origin (point))
- (end (save-excursion
- (org-with-limited-levels (outline-next-heading)) (point)))
- element type special-flag trail struct prevs parent)
- (org-with-limited-levels
- (if (org-before-first-heading-p)
- ;; In empty lines at buffer's beginning, return nil.
- (progn (goto-char (point-min))
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- (throw 'exit nil)))
- (org-back-to-heading)
- (forward-line)
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- ;; In blank lines just after the headline, point still
- ;; belongs to the headline.
- (throw 'exit
- (progn (skip-chars-backward " \r\t\n")
- (beginning-of-line)
- (if (not keep-trail)
- (org-element-headline-parser (point-max) t)
- (list (org-element-headline-parser
- (point-max) t))))))))
+ (let ((origin (point)))
+ (if (not (org-with-limited-levels (outline-previous-heading)))
+ ;; In empty lines at buffer's beginning, return nil.
+ (progn (goto-char (point-min))
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ (throw 'exit nil)))
+ (forward-line)
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ ;; In blank lines just after the headline, point still
+ ;; belongs to the headline.
+ (throw 'exit
+ (progn
+ (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ (let ((headline
+ (or (org-element-cache-get (point) 'element)
+ (car (org-element-cache-put
+ (point)
+ (list (org-element-headline-parser
+ (point-max) t)))))))
+ (if keep-trail (list headline) headline))))))
(beginning-of-line)
- ;; Parse successively each element, skipping those ending
- ;; before original position.
- (while t
- (setq element
- (org-element--current-element end 'element special-flag struct)
- type (car element))
- (org-element-put-property element :parent parent)
- (when keep-trail (push element trail))
- (cond
- ;; 1. Skip any element ending before point. Also skip
- ;; element ending at point when we're sure that another
- ;; element has started.
- ((let ((elem-end (org-element-property :end element)))
- (when (or (< elem-end origin)
- (and (= elem-end origin) (/= elem-end end)))
- (goto-char elem-end))))
- ;; 2. An element containing point is always the element at
- ;; point.
- ((not (memq type org-element-greater-elements))
- (throw 'exit (if keep-trail trail element)))
- ;; 3. At any other greater element type, if point is
- ;; within contents, move into it.
- (t
- (let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
- (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
- ;; Create an anchor for tables and plain lists:
- ;; when point is at the very beginning of these
- ;; elements, ignoring affiliated keywords,
- ;; target them instead of their contents.
- (and (= cbeg origin) (memq type '(plain-list table)))
- ;; When point is at contents end, do not move
- ;; into elements with an explicit ending, but
- ;; return that element instead.
- (and (= cend origin)
- (or (memq type
- '(center-block
- drawer dynamic-block inlinetask
- property-drawer quote-block
- special-block))
- ;; Corner case: if a list ends at the
- ;; end of a buffer without a final new
- ;; line, return last element in last
- ;; item instead.
- (and (memq type '(item plain-list))
- (progn (goto-char cend)
- (or (bolp) (not (eobp))))))))
- (throw 'exit (if keep-trail trail element))
- (setq parent element)
- (case type
- (plain-list
- (setq special-flag 'item
- struct (org-element-property :structure element)))
- (item (setq special-flag nil))
- (property-drawer
- (setq special-flag 'node-property struct nil))
- (table (setq special-flag 'table-row struct nil))
- (otherwise (setq special-flag nil struct nil)))
- (setq end cend)
- (goto-char cbeg)))))))))))
+ (let ((end (save-excursion
+ (org-with-limited-levels (outline-next-heading)) (point)))
+ element type special-flag trail struct parent)
+ ;; Parse successively each element, skipping those ending
+ ;; before original position.
+ (while t
+ (setq element
+ (let* ((pos (if (and (memq special-flag '(item table-row))
+ (memq type '(plain-list table)))
+ ;; First item (resp. row) in plain
+ ;; list (resp. table) get a special
+ ;; key in cache.
+ (1+ (point))
+ (point)))
+ (cached (org-element-cache-get pos 'element)))
+ (cond
+ ((not cached)
+ (let ((element (org-element--current-element
+ end 'element special-flag struct)))
+ (when (derived-mode-p 'org-mode)
+ (org-element-cache-put pos (cons element nil)))
+ element))
+ ;; When changes happened in the middle of a list,
+ ;; its structure ends up being invalid.
+ ;; Therefore, we make sure to use a valid one.
+ ((and struct (memq (car cached) '(item plain-list)))
+ (org-element-put-property cached :structure struct))
+ (t cached))))
+ (setq type (org-element-type element))
+ (org-element-put-property element :parent parent)
+ (when keep-trail (push element trail))
+ (cond
+ ;; 1. Skip any element ending before point. Also skip
+ ;; element ending at point when we're sure that
+ ;; another element has started.
+ ((let ((elem-end (org-element-property :end element)))
+ (when (or (< elem-end origin)
+ (and (= elem-end origin) (/= elem-end end)))
+ (goto-char elem-end))))
+ ;; 2. An element containing point is always the element at
+ ;; point.
+ ((not (memq type org-element-greater-elements))
+ (throw 'exit (if keep-trail trail element)))
+ ;; 3. At any other greater element type, if point is
+ ;; within contents, move into it.
+ (t
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
+ ;; Create an anchor for tables and plain
+ ;; lists: when point is at the very beginning
+ ;; of these elements, ignoring affiliated
+ ;; keywords, target them instead of their
+ ;; contents.
+ (and (= cbeg origin) (memq type '(plain-list table)))
+ ;; When point is at contents end, do not move
+ ;; into elements with an explicit ending, but
+ ;; return that element instead.
+ (and (= cend origin)
+ (or (memq type
+ '(center-block
+ drawer dynamic-block inlinetask
+ property-drawer quote-block
+ special-block))
+ ;; Corner case: if a list ends at
+ ;; the end of a buffer without
+ ;; a final new line, return last
+ ;; element in last item instead.
+ (and (memq type '(item plain-list))
+ (progn (goto-char cend)
+ (or (bolp) (not (eobp))))))))
+ (throw 'exit (if keep-trail trail element))
+ (setq parent element)
+ (case type
+ (plain-list
+ (setq special-flag 'item
+ struct (org-element-property :structure element)))
+ (item (setq special-flag nil))
+ (property-drawer
+ (setq special-flag 'node-property struct nil))
+ (table (setq special-flag 'table-row struct nil))
+ (otherwise (setq special-flag nil struct nil)))
+ (setq end cend)
+ (goto-char cbeg))))))))))))
;;;###autoload
(defun org-element-context (&optional element)
@@ -4794,11 +5222,10 @@ Providing it allows for quicker computation."
(org-with-wide-buffer
(let* ((origin (point))
(element (or element (org-element-at-point)))
- (type (org-element-type element))
- context)
- ;; Check if point is inside an element containing objects or at
- ;; a secondary string. In that case, narrow buffer to the
- ;; containing area. Otherwise, return ELEMENT.
+ (type (org-element-type element)))
+ ;; If point is inside an element containing objects or
+ ;; a secondary string, narrow buffer to the container and
+ ;; proceed with parsing. Otherwise, return ELEMENT.
(cond
;; At a parsed affiliated keyword, check if we're inside main
;; or dual value.
@@ -4828,8 +5255,7 @@ Providing it allows for quicker computation."
(if (and (>= origin (point)) (< origin (match-end 0)))
(narrow-to-region (point) (match-end 0))
(throw 'objects-forbidden element)))))
- ;; At an headline or inlinetask, objects are located within
- ;; their title.
+ ;; At an headline or inlinetask, objects are in title.
((memq type '(headline inlinetask))
(goto-char (org-element-property :begin element))
(skip-chars-forward "* ")
@@ -4855,44 +5281,92 @@ Providing it allows for quicker computation."
(if (and (>= origin (point)) (< origin (line-end-position)))
(narrow-to-region (point) (line-end-position))
(throw 'objects-forbidden element))))
+ ;; All other locations cannot contain objects: bail out.
(t (throw 'objects-forbidden element)))
(goto-char (point-min))
- (let ((restriction (org-element-restriction type))
- (parent element)
- (candidates 'initial))
- (catch 'exit
- (while (setq candidates
- (org-element--get-next-object-candidates
- restriction candidates))
- (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
- candidates)))
- ;; If ORIGIN is before next object in element, there's
- ;; no point in looking further.
- (if (> (cdr closest-cand) origin) (throw 'exit parent)
- (let* ((object
- (progn (goto-char (cdr closest-cand))
- (funcall (intern (format "org-element-%s-parser"
- (car closest-cand))))))
- (cbeg (org-element-property :contents-begin object))
- (cend (org-element-property :contents-end object))
- (obj-end (org-element-property :end object)))
- (cond
- ;; ORIGIN is after OBJECT, so skip it.
- ((<= obj-end origin) (goto-char obj-end))
- ;; ORIGIN is within a non-recursive object or at
- ;; an object boundaries: Return that object.
- ((or (not cbeg) (< origin cbeg) (>= origin cend))
- (throw 'exit
- (org-element-put-property object :parent parent)))
- ;; Otherwise, move within current object and
- ;; restrict search to the end of its contents.
- (t (goto-char cbeg)
- (narrow-to-region (point) cend)
- (org-element-put-property object :parent parent)
- (setq parent object
- restriction (org-element-restriction object)
- candidates 'initial)))))))
- parent))))))
+ (let* ((restriction (org-element-restriction type))
+ (parent element)
+ (candidates 'initial)
+ (cache-key (org-element--cache-get-key element))
+ (cache (org-element-cache-get cache-key 'objects))
+ objects-data next update-cache-flag)
+ (prog1
+ (catch 'exit
+ (while t
+ ;; Get list of next object candidates in CANDIDATES.
+ ;; When entering for the first time PARENT, grab it
+ ;; from cache, if available, or compute it. Then,
+ ;; for each subsequent iteration in PARENT, always
+ ;; compute it since we're beyond cache anyway.
+ (when (and (not next) org-element-use-cache)
+ (let ((data (assq (point) cache)))
+ (if data (setq candidates (nth 1 (setq objects-data data)))
+ (push (setq objects-data (list (point) 'initial))
+ cache))))
+ (when (or next (eq 'initial candidates))
+ (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates))
+ (when org-element-use-cache
+ (setcar (cdr objects-data) candidates)
+ (or update-cache-flag (setq update-cache-flag t))))
+ ;; Compare ORIGIN with next object starting position,
+ ;; if any.
+ ;;
+ ;; If ORIGIN is lesser or if there is no object
+ ;; following, look for a previous object that might
+ ;; contain it in cache. If there is no cache, we
+ ;; didn't miss any object so simply return PARENT.
+ ;;
+ ;; If ORIGIN is greater or equal, parse next
+ ;; candidate for further processing.
+ (let ((closest
+ (and candidates
+ (rassq (apply #'min (mapcar #'cdr candidates))
+ candidates))))
+ (if (or (not closest) (> (cdr closest) origin))
+ (catch 'found
+ (dolist (obj (cddr objects-data) (throw 'exit parent))
+ (when (<= (org-element-property :begin obj) origin)
+ (if (<= (org-element-property :end obj) origin)
+ ;; Object ends before ORIGIN and we
+ ;; know next one in cache starts
+ ;; after it: bail out.
+ (throw 'exit parent)
+ (throw 'found (setq next obj))))))
+ (goto-char (cdr closest))
+ (setq next
+ (funcall (intern (format "org-element-%s-parser"
+ (car closest)))))
+ (when org-element-use-cache
+ (push next (cddr objects-data))
+ (or update-cache-flag (setq update-cache-flag t)))))
+ ;; Process NEXT to know if we need to skip it, return
+ ;; it or move into it.
+ (let ((cbeg (org-element-property :contents-begin next))
+ (cend (org-element-property :contents-end next))
+ (obj-end (org-element-property :end next)))
+ (cond
+ ;; ORIGIN is after NEXT, so skip it.
+ ((<= obj-end origin) (goto-char obj-end))
+ ;; ORIGIN is within a non-recursive next or
+ ;; at an object boundaries: Return that object.
+ ((or (not cbeg) (< origin cbeg) (>= origin cend))
+ (throw 'exit
+ (org-element-put-property next :parent parent)))
+ ;; Otherwise, move into NEXT and reset flags as we
+ ;; shift parent.
+ (t (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (org-element-put-property next :parent parent)
+ (setq parent next
+ restriction (org-element-restriction next)
+ next nil
+ objects-data nil
+ candidates 'initial))))))
+ ;; Update cache if required.
+ (when (and update-cache-flag (derived-mode-p 'org-mode))
+ (org-element-cache-put cache-key (cons element cache)))))))))
(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index ce9803f..2bebc7c 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -858,25 +858,29 @@ Some other text
(ert-deftest test-org-element/headline-archive-tag ()
"Test ARCHIVE tag recognition."
;; Reference test.
- (org-test-with-temp-text "* Headline"
- (let ((org-archive-tag "ARCHIVE"))
- (should-not (org-element-property :archivedp (org-element-at-point)))))
+ (should-not
+ (org-test-with-temp-text "* Headline"
+ (let ((org-archive-tag "ARCHIVE"))
+ (org-element-property :archivedp (org-element-at-point)))))
;; Single tag.
(org-test-with-temp-text "* Headline :ARCHIVE:"
(let ((org-archive-tag "ARCHIVE"))
(let ((headline (org-element-at-point)))
(should (org-element-property :archivedp headline))
;; Test tag removal.
- (should-not (org-element-property :tags headline))))
- (let ((org-archive-tag "Archive"))
- (should-not (org-element-property :archivedp (org-element-at-point)))))
+ (should-not (org-element-property :tags headline)))))
;; Multiple tags.
(org-test-with-temp-text "* Headline :test:ARCHIVE:"
(let ((org-archive-tag "ARCHIVE"))
(let ((headline (org-element-at-point)))
(should (org-element-property :archivedp headline))
;; Test tag removal.
- (should (equal (org-element-property :tags headline) '("test")))))))
+ (should (equal (org-element-property :tags headline) '("test"))))))
+ ;; Tag is case-sensitive.
+ (should-not
+ (org-test-with-temp-text "* Headline :ARCHIVE:"
+ (let ((org-archive-tag "Archive"))
+ (org-element-property :archivedp (org-element-at-point))))))
(ert-deftest test-org-element/headline-properties ()
"Test properties from property drawer."
--
1.8.4
^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [RFC] Simple cache mechanism for `org-element-at-point'
2013-10-03 21:18 [RFC] Simple cache mechanism for `org-element-at-point' Nicolas Goaziou
@ 2013-10-04 5:43 ` Eric Abrahamsen
2013-10-04 8:53 ` Nicolas Goaziou
2013-10-04 9:13 ` Carsten Dominik
2013-10-27 8:52 ` Nicolas Goaziou
2 siblings, 1 reply; 9+ messages in thread
From: Eric Abrahamsen @ 2013-10-04 5:43 UTC (permalink / raw)
To: emacs-orgmode
Nicolas Goaziou <n.goaziou@gmail.com> writes:
> Hello,
>
> The following patches introduce a simple cache mechanism for both
> `org-element-at-point' and `org-element-context'. My goal is to make
> them fast enough to be used in most core commands (excepted
> headlines-only commands).
>
> Since a wrong cache can break Org behaviour badly, I would appreciate if
> it could be tested a bit. You can disable cache at any time by setting
> `org-element-use-cache' to nil and reset it with
> `org-element-cache-reset' function.
>
> It may also be interesting to tweak `org-element--cache-sync-idle-time'
> and `org-element--cache-merge-changes-threshold', although I don't
> expect a regular user to do it. Anyway, it may lead to better default
> values.
>
> Since cache is updated upon buffer modification, visibility status
> cannot be cached properly. Since it is also buggy, the first patch
> removes that data altogether.
Cool! Anything in particular that we should be looking out for
(structure editing, export, etc)? It has so far not set my computer on
fire.
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [RFC] Simple cache mechanism for `org-element-at-point'
2013-10-04 5:43 ` Eric Abrahamsen
@ 2013-10-04 8:53 ` Nicolas Goaziou
0 siblings, 0 replies; 9+ messages in thread
From: Nicolas Goaziou @ 2013-10-04 8:53 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: emacs-orgmode
Hello,
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> Cool! Anything in particular that we should be looking out for
> (structure editing, export, etc)? It has so far not set my computer on
> fire.
Unfortunately, there is no simple recipe to try it out. Just use Org
and, if you notice something suspicious, disable cache and try again.
FYI, most sensitive cache operations happen when a headline, a block or
a drawer in inserted, modifier or deleted.
Thanks for testing it.
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [RFC] Simple cache mechanism for `org-element-at-point'
2013-10-03 21:18 [RFC] Simple cache mechanism for `org-element-at-point' Nicolas Goaziou
2013-10-04 5:43 ` Eric Abrahamsen
@ 2013-10-04 9:13 ` Carsten Dominik
2013-10-04 17:15 ` Nicolas Goaziou
2013-10-27 8:52 ` Nicolas Goaziou
2 siblings, 1 reply; 9+ messages in thread
From: Carsten Dominik @ 2013-10-04 9:13 UTC (permalink / raw)
To: Nicolas Goaziou; +Cc: Org Mode List
[-- Attachment #1: Type: text/plain, Size: 1974 bytes --]
Hi Nicolas,
this sounds like a great idea. I have not yet had the time to
test it - but I would like to bring forward two basic worries.
Maybe you have comments on them?
1. Updating on buffer modification hooks sounds like a very
demanding process. You basically add a third expensive process
in addition to font locking and org-indent-mode. My worry is
that this might be very heavy on Emacs and slow down fast workers.
Again, I did not try it, just a worry
2. Do you expect this to be stable enough to deal with buffers that
are invalid in some way or another? Are there any situations in
which the parser could fail and leave some weird state behind?
3. Can you explain what you mean by "except in headline-only commands?
Thank you!
- Carsten
On 3.10.2013, at 23:18, Nicolas Goaziou <n.goaziou@gmail.com> wrote:
> Hello,
>
> The following patches introduce a simple cache mechanism for both
> `org-element-at-point' and `org-element-context'. My goal is to make
> them fast enough to be used in most core commands (excepted
> headlines-only commands).
>
> Since a wrong cache can break Org behaviour badly, I would appreciate if
> it could be tested a bit. You can disable cache at any time by setting
> `org-element-use-cache' to nil and reset it with
> `org-element-cache-reset' function.
>
> It may also be interesting to tweak `org-element--cache-sync-idle-time'
> and `org-element--cache-merge-changes-threshold', although I don't
> expect a regular user to do it. Anyway, it may lead to better default
> values.
>
> Since cache is updated upon buffer modification, visibility status
> cannot be cached properly. Since it is also buggy, the first patch
> removes that data altogether.
>
> Feedback welcome.
>
>
> Regards,
>
> --
> Nicolas Goaziou
> <0001-org-element-Remove-folding-status-in-parsed-data.patch><0002-org-element-Implement-caching-for-dynamic-parser.patch>
[-- Attachment #2: Message signed with OpenPGP using GPGMail --]
[-- Type: application/pgp-signature, Size: 455 bytes --]
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [RFC] Simple cache mechanism for `org-element-at-point'
2013-10-04 9:13 ` Carsten Dominik
@ 2013-10-04 17:15 ` Nicolas Goaziou
0 siblings, 0 replies; 9+ messages in thread
From: Nicolas Goaziou @ 2013-10-04 17:15 UTC (permalink / raw)
To: Carsten Dominik; +Cc: Org Mode List
Hello,
Carsten Dominik <carsten.dominik@gmail.com> writes:
> 1. Updating on buffer modification hooks sounds like a very
> demanding process.
There is obviously a cost, but it shouldn't be very high. I simplified
the process in the announcement. Actually, the cache is not updated
right after each buffer modification. What happens is the following:
- After each buffer modification, a changeset is stored in
a buffer-local variable. Building the changeset requires between
1 and 4 regexp searches between the boundaries of the change.
- When Emacs is idle cache is updated according to that changeset (see
`org-element--cache-sync-idle-time') and the changeset is erased.
- If a modification happens while another previous changeset is still
present, either changesets are merged into a single one (see
`org-element--cache-merge-changes-threshold'), or, in the worst
case, a cache sync is called in order to get rid of the old
changeset, and the new one is stored.
> You basically add a third expensive process in addition to font
> locking and org-indent-mode.
The plan is to use `org-element-at-point' for both of them, so all three
will ultimately become only one process.
> My worry is that this might be very heavy on Emacs and slow down
> fast workers. Again, I did not try it, just a worry
It obviously needs to be tested, but I would be surprised if it happened
to be a problem, at least with a compiled Org (no clue on an uncompiled
one).
> 2. Do you expect this to be stable enough to deal with buffers that
> are invalid in some way or another? Are there any situations in which
> the parser could fail and leave some weird state behind?
There is nothing invalid at `org-element-at-point' level (i.e. it
shouldn't error, ever). Invalid syntax means that what the parser sees
doesn't match user's expectations. So there is, theoretically, no reason
for the parser to fail. But there are bugs, and only testing will
uncover them.
> 3. Can you explain what you mean by "except in headline-only commands?
`org-element-at-point' is meant to replace all `org-at-...'-like
functions. Calling `org-element-at-point' is like calling all of them at
the same time. It's more expensive than any of them, but returns more
data and is always correct.
But you don't need to know about context to tell if you're one
a headline or not, so `org-at-heading-p' is almost always a superior
choice (unless you need to also retrieve node properties). Likewise, if
you only need to manipulate headlines, you don't need any context
information.
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [RFC] Simple cache mechanism for `org-element-at-point'
2013-10-03 21:18 [RFC] Simple cache mechanism for `org-element-at-point' Nicolas Goaziou
2013-10-04 5:43 ` Eric Abrahamsen
2013-10-04 9:13 ` Carsten Dominik
@ 2013-10-27 8:52 ` Nicolas Goaziou
2013-10-30 10:06 ` Nicolas Goaziou
2 siblings, 1 reply; 9+ messages in thread
From: Nicolas Goaziou @ 2013-10-27 8:52 UTC (permalink / raw)
To: Org Mode List
[-- Attachment #1: Type: text/plain, Size: 1140 bytes --]
Nicolas Goaziou <n.goaziou@gmail.com> writes:
> The following patches introduce a simple cache mechanism for both
> `org-element-at-point' and `org-element-context'. My goal is to make
> them fast enough to be used in most core commands (excepted
> headlines-only commands).
>
> Since a wrong cache can break Org behaviour badly, I would appreciate if
> it could be tested a bit. You can disable cache at any time by setting
> `org-element-use-cache' to nil and reset it with
> `org-element-cache-reset' function.
>
> It may also be interesting to tweak `org-element--cache-sync-idle-time'
> and `org-element--cache-merge-changes-threshold', although I don't
> expect a regular user to do it. Anyway, it may lead to better default
> values.
>
> Since cache is updated upon buffer modification, visibility status
> cannot be cached properly. Since it is also buggy, the first patch
> removes that data altogether.
I applied the first patch.
Here is a slight change to the second one, which will correctly reset
cache when some variables are customized or when a buffer is refreshed
(C-c C-c on a keyword).
Regards,
--
Nicolas Goaziou
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-org-element-Implement-caching-for-dynamic-parser.patch --]
[-- Type: text/x-diff, Size: 41629 bytes --]
From 6fa0c2908c9cc3c768ec484ce9d7f87a971a4fa5 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <n.goaziou@gmail.com>
Date: Thu, 3 Oct 2013 22:12:35 +0200
Subject: [PATCH] org-element: Implement caching for dynamic parser
* lisp/org-element.el (org-element-use-cache, org-element--cache,
org-element--cache-sync-idle-time,
org-element--cache-merge-changes-threshold, org-element--cache-status,
org-element--cache-opening-line, org-element--cache-closing-line): New
variables.
(org-element-cache-reset, org-element--cache-pending-changes-p,
org-element--cache-push-change, org-element--cache-cancel-changes,
org-element--cache-get-key, org-element-cache-get,
org-element-cache-put, org-element--shift-positions,
org-element--cache-before-change, org-element--cache-record-change,
org-element--cache-sync): New functions.
(org-element-at-point, org-element-context): Use cache when possible.
* lisp/org.el (org-mode, org-set-modules): Reset cache.
* lisp/org-footnote.el (org-footnote-section): Reset cache.
* lisp/org-src.el (org-src-preserve-indentation): Reset cache.
* testing/lisp/test-org-element.el: Update tests.
This patch gives a boost to `org-element-at-point' and, to a lesser
extent, to `org-element-context'.
---
lisp/org-element.el | 750 ++++++++++++++++++++++++++++++++-------
| 9 +-
lisp/org-src.el | 25 +-
lisp/org.el | 6 +-
testing/lisp/test-org-element.el | 18 +-
5 files changed, 658 insertions(+), 150 deletions(-)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 329d00a..cbe0e56 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -111,7 +111,8 @@
;;
;; The library ends by furnishing `org-element-at-point' function, and
;; a way to give information about document structure around point
-;; with `org-element-context'.
+;; with `org-element-context'. A simple cache mechanism is also
+;; provided for these functions.
;;; Code:
@@ -4646,7 +4647,7 @@ indentation is not done with TAB characters."
;; The first move is to implement a way to obtain the smallest element
;; containing point. This is the job of `org-element-at-point'. It
;; basically jumps back to the beginning of section containing point
-;; and moves, element after element, with
+;; and proceed, one element after the other, with
;; `org-element--current-element' until the container is found. Note:
;; When using `org-element-at-point', secondary values are never
;; parsed since the function focuses on elements, not on objects.
@@ -4654,8 +4655,417 @@ indentation is not done with TAB characters."
;; At a deeper level, `org-element-context' lists all elements and
;; objects containing point.
;;
-;; `org-element-nested-p' and `org-element-swap-A-B' may be used
-;; internally by navigation and manipulation tools.
+;; Both functions benefit from a simple caching mechanism. It is
+;; enabled by default, but can be disabled globally with
+;; `org-element-use-cache'. Also `org-element-cache-reset' clears or
+;; initializes cache for current buffer. Values are retrieved and put
+;; into cache with respectively, `org-element-cache-get' and
+;; `org-element-cache-put'. `org-element--cache-sync-idle-time' and
+;; `org-element--cache-merge-changes-threshold' are used internally to
+;; control caching behaviour.
+;;
+;; Eventually `org-element-nested-p' and `org-element-swap-A-B' may be
+;; used internally by navigation and manipulation tools.
+
+(defvar org-element-use-cache t
+ "Non nil when Org parser should cache its results.")
+
+(defvar org-element--cache nil
+ "Hash table used as a cache for parser.
+Key is a buffer position and value is a cons cell with the
+pattern:
+
+ \(ELEMENT . OBJECTS-DATA)
+
+where ELEMENT is the element starting at the key and OBJECTS-DATA
+is an alist where each association is:
+
+ \(POS CANDIDATES . OBJECTS)
+
+where POS is a buffer position, CANDIDATES is the last know list
+of successors (see `org-element--get-next-object-candidates') in
+container starting at POS and OBJECTS is a list of objects known
+to live within that container, from farthest to closest.
+
+In the following example, \\alpha, bold object and \\beta start
+at, respectively, positions 1, 7 and 8,
+
+ \\alpha *\\beta*
+
+If the paragraph is completely parsed, OBJECTS-DATA will be
+
+ \((1 nil BOLD-OBJECT ENTITY-OBJECT)
+ \(8 nil ENTITY-OBJECT))
+
+whereas in a partially parsed paragraph, it could be
+
+ \((1 ((entity . 1) (bold . 7)) ENTITY-OBJECT))
+
+This cache is used in both `org-element-at-point' and
+`org-element-context'. The former uses ELEMENT only and the
+latter OBJECTS-DATA only.")
+
+(defvar org-element--cache-sync-idle-time 0.5
+ "Number of seconds of idle time wait before syncing buffer cache.
+Syncing also happens when current modification is too distant
+from the stored one (for more information, see
+`org-element--cache-merge-changes-threshold').")
+
+(defvar org-element--cache-merge-changes-threshold 200
+ "Number of characters triggering cache syncing.
+
+The cache mechanism only stores one buffer modification at any
+given time. When another change happens, it replaces it with
+a change containing both the stored modification and the current
+one. This is a trade-off, as merging them prevents another
+syncing, but every element between them is then lost.
+
+This variable determines the maximum size, in characters, we
+accept to lose in order to avoid syncing the cache.")
+
+(defvar org-element--cache-status nil
+ "Contains data about cache validity for current buffer.
+
+Value is a vector of seven elements,
+
+ [ACTIVEP BEGIN END OFFSET TIMER PREVIOUS-STATE]
+
+ACTIVEP is a boolean non-nil when changes described in the other
+slots are valid for current buffer.
+
+BEGIN and END are the beginning and ending position of the area
+for which cache cannot be trusted.
+
+OFFSET it an integer specifying the number to add to position of
+elements after that area.
+
+TIMER is a timer used to apply these changes to cache when Emacs
+is idle.
+
+PREVIOUS-STATE is a symbol referring to the state of the buffer
+before a change happens. It is used to know if sensitive
+areas (block boundaries, headlines) were modified. It can be set
+to nil, `headline' or `other'.")
+
+;;;###autoload
+(defun org-element-cache-reset (&optional all)
+ "Reset cache in current buffer.
+When optional argument ALL is non-nil, reset cache in all Org
+buffers. This function will do nothing if
+`org-element-use-cache' is nil."
+ (interactive "P")
+ (when org-element-use-cache
+ (dolist (buffer (if all (buffer-list) (list (current-buffer))))
+ (with-current-buffer buffer
+ (when (derived-mode-p 'org-mode)
+ (if (org-bound-and-true-p org-element--cache)
+ (clrhash org-element--cache)
+ (org-set-local 'org-element--cache
+ (make-hash-table :size 5003 :test 'eq)))
+ (org-set-local 'org-element--cache-status (make-vector 6 nil))
+ (add-hook 'before-change-functions
+ 'org-element--cache-before-change nil t)
+ (add-hook 'after-change-functions
+ 'org-element--cache-record-change nil t))))))
+
+(defsubst org-element--cache-pending-changes-p ()
+ "Non-nil when changes are not integrated in cache yet."
+ (and org-element--cache-status
+ (aref org-element--cache-status 0)))
+
+(defsubst org-element--cache-push-change (beg end offset)
+ "Push change to current buffer staging area.
+BEG and END and the beginning and ending position of the
+modification area. OFFSET is the size of the change, as an
+integer."
+ (aset org-element--cache-status 1 beg)
+ (aset org-element--cache-status 2 end)
+ (aset org-element--cache-status 3 offset)
+ (let ((timer (aref org-element--cache-status 4)))
+ (if timer (timer-activate-when-idle timer t)
+ (aset org-element--cache-status 4
+ (run-with-idle-timer org-element--cache-sync-idle-time
+ nil
+ #'org-element--cache-sync
+ (current-buffer)))))
+ (aset org-element--cache-status 0 t))
+
+(defsubst org-element--cache-cancel-changes ()
+ "Remove any cache change set for current buffer."
+ (let ((timer (aref org-element--cache-status 4)))
+ (and timer (cancel-timer timer)))
+ (aset org-element--cache-status 0 nil))
+
+(defsubst org-element--cache-get-key (element)
+ "Return expected key for ELEMENT in cache."
+ (let ((begin (org-element-property :begin element)))
+ (if (and (memq (org-element-type element) '(item table-row))
+ (= (org-element-property :contents-begin
+ (org-element-property :parent element))
+ begin))
+ ;; Special key for first item (resp. table-row) in a plain
+ ;; list (resp. table).
+ (1+ begin)
+ begin)))
+
+(defsubst org-element-cache-get (pos &optional type)
+ "Return data stored at key POS in current buffer cache.
+When optional argument TYPE is `element', retrieve the element
+starting at POS. When it is `objects', return the list of object
+types along with their beginning position within that element.
+Otherwise, return the full data. In any case, return nil if no
+data is found, or if caching is not allowed."
+ (when (and org-element-use-cache org-element--cache)
+ ;; If there are pending changes, first sync them.
+ (when (org-element--cache-pending-changes-p)
+ (org-element--cache-sync (current-buffer)))
+ (let ((data (gethash pos org-element--cache)))
+ (case type
+ (element (car data))
+ (objects (cdr data))
+ (otherwise data)))))
+
+(defsubst org-element-cache-put (pos data)
+ "Store data in current buffer's cache, if allowed.
+POS is a buffer position, which will be used as a key. DATA is
+the value to store. Nothing will be stored if
+`org-element-use-cache' is nil. Return DATA in any case."
+ (if (not org-element-use-cache) data
+ (unless org-element--cache (org-element-cache-reset))
+ (puthash pos data org-element--cache)))
+
+(defsubst org-element--shift-positions (element offset)
+ "Shift ELEMENT properties relative to buffer positions by OFFSET.
+Properties containing buffer positions are `:begin', `:end',
+`:contents-begin', `:contents-end' and `:structure'. They are
+modified by side-effect. Return modified element."
+ (let ((properties (nth 1 element)))
+ ;; Shift :structure property for the first plain list only: it is
+ ;; the only one that really matters and it prevents from shifting
+ ;; it more than once.
+ (when (eq (car element) 'plain-list)
+ (let ((structure (plist-get properties :structure)))
+ (when (<= (plist-get properties :begin) (caar structure))
+ (dolist (item structure)
+ (incf (car item) offset)
+ (incf (nth 6 item) offset)))))
+ (plist-put properties :begin (+ (plist-get properties :begin) offset))
+ (plist-put properties :end (+ (plist-get properties :end) offset))
+ (dolist (key '(:contents-begin :contents-end :post-affiliated))
+ (let ((value (plist-get properties key)))
+ (and value (plist-put properties key (+ offset value))))))
+ element)
+
+(defconst org-element--cache-opening-line
+ (concat "^[ \t]*\\(?:"
+ "#\\+BEGIN[:_]" "\\|"
+ "\\\\begin{[A-Za-z0-9]+\\*?}" "\\|"
+ ":\\S-+:[ \t]*$"
+ "\\)")
+ "Regexp matching an element opening line.
+When such a line is modified, modifications may propagate after
+modified area. In that situation, every element between that
+area and next section is removed from cache.")
+
+(defconst org-element--cache-closing-line
+ (concat "^[ \t]*\\(?:"
+ "#\\+END\\(?:_\\|:?[ \t]*$\\)" "\\|"
+ "\\\\end{[A-Za-z0-9]+\\*?}[ \t]*$" "\\|"
+ ":END:[ \t]*$"
+ "\\)")
+ "Regexp matching an element closing line.
+When such a line is modified, modifications may propagate before
+modified area. In that situation, every element between that
+area and previous section is removed from cache.")
+
+(defun org-element--cache-before-change (beg end)
+ "Request extension of area going to be modified if needed.
+BEG and END are the beginning and end of the range of changed
+text. See `before-change-functions' for more information."
+ (let ((inhibit-quit t))
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (let ((top (point))
+ (bottom (save-excursion (goto-char end) (line-end-position)))
+ (sensitive-re
+ ;; A sensitive line is a headline or a block (or drawer,
+ ;; or latex-environment) boundary. Inserting one can
+ ;; modify buffer drastically both above and below that
+ ;; line, possibly making cache invalid. Therefore, we
+ ;; need to pay special attention to changes happening to
+ ;; them.
+ (concat
+ "\\(" (org-with-limited-levels org-outline-regexp-bol) "\\)" "\\|"
+ org-element--cache-closing-line "\\|"
+ org-element--cache-opening-line)))
+ (save-match-data
+ (aset org-element--cache-status 5
+ (cond ((not (re-search-forward sensitive-re bottom t)) nil)
+ ((and (match-beginning 1)
+ (progn (goto-char bottom)
+ (or (not (re-search-backward sensitive-re
+ (match-end 1) t))
+ (match-beginning 1))))
+ 'headline)
+ (t 'other))))))))
+
+(defun org-element--cache-record-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.
+
+If there are already pending changes, try to merge them into
+a bigger change record. If that's not possible, the function
+will first synchronize cache with previous change and store the
+new one."
+ (let ((inhibit-quit t))
+ (when (and org-element-use-cache org-element--cache)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (let ((top (point))
+ (bottom (save-excursion (goto-char end) (line-end-position))))
+ (org-with-limited-levels
+ (save-match-data
+ ;; 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 (let ((previous-state (aref org-element--cache-status 5))
+ (sensitive-re
+ (concat "\\(" org-outline-regexp-bol "\\)" "\\|"
+ org-element--cache-closing-line "\\|"
+ org-element--cache-opening-line)))
+ (cond ((eq previous-state 'other))
+ ((not (re-search-forward sensitive-re bottom t))
+ (eq previous-state 'headline))
+ ((match-beginning 1)
+ (or (not (eq previous-state 'headline))
+ (and (progn (goto-char bottom)
+ (re-search-backward
+ sensitive-re (match-end 1) t))
+ (not (match-beginning 1)))))
+ (t)))
+ ;; Effectively extend modified area.
+ (setq top (progn (goto-char top)
+ (outline-previous-heading)
+ ;; Headline above is inclusive.
+ (point)))
+ (setq bottom (progn (goto-char bottom)
+ (outline-next-heading)
+ ;; Headline below is exclusive.
+ (if (eobp) (point) (1- (point))))))))
+ ;; Store changes.
+ (let ((offset (- end beg pre)))
+ (if (not (org-element--cache-pending-changes-p))
+ ;; No pending changes. Store the new ones.
+ (org-element--cache-push-change top (- bottom offset) offset)
+ (let* ((current-start (aref org-element--cache-status 1))
+ (current-end (+ (aref org-element--cache-status 2)
+ (aref org-element--cache-status 3)))
+ (gap (max (- beg current-end) (- current-start end))))
+ (if (> gap org-element--cache-merge-changes-threshold)
+ ;; If we cannot merge two change sets (i.e. they
+ ;; modify distinct buffer parts) first apply current
+ ;; change set and store new one. This way, there is
+ ;; never more than one pending change set, which
+ ;; avoids handling costly merges.
+ (progn (org-element--cache-sync (current-buffer))
+ (org-element--cache-push-change
+ top (- bottom offset) offset))
+ ;; Change sets can be merged. We can expand the area
+ ;; that requires an update, and postpone the sync.
+ (timer-activate-when-idle (aref org-element--cache-status 4) t)
+ (aset org-element--cache-status 0 t)
+ (aset org-element--cache-status 1 (min top current-start))
+ (aset org-element--cache-status 2
+ (- (max current-end bottom) offset))
+ (incf (aref org-element--cache-status 3) offset))))))))))
+
+(defun org-element--cache-sync (buffer)
+ "Synchronize cache with recent modification in BUFFER.
+Elements ending before modification area are kept in cache.
+Elements starting after modification area have their position
+shifted by the size of the modification. Every other element is
+removed from the cache."
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (when (org-element--cache-pending-changes-p)
+ (let ((inhibit-quit t)
+ (beg (aref org-element--cache-status 1))
+ (end (aref org-element--cache-status 2))
+ (offset (aref org-element--cache-status 3))
+ new-keys)
+ (maphash
+ #'(lambda (key value)
+ (cond
+ ((memq key new-keys))
+ ((> key end)
+ ;; Shift every element starting after END by OFFSET.
+ ;; We also need to shift keys, since they refer to
+ ;; buffer positions.
+ ;;
+ ;; Upon shifting a key a conflict can occur if the
+ ;; shifted key also refers to some element in the
+ ;; cache. In this case, we temporarily associate
+ ;; both elements, as a cons cell, to the shifted key,
+ ;; following the pattern (SHIFTED . CURRENT).
+ ;;
+ ;; Such a conflict can only occur if shifted key hash
+ ;; hasn't been processed by `maphash' yet.
+ (unless (zerop offset)
+ (let* ((conflictp (consp (caar value)))
+ (value-to-shift (if conflictp (cdr value) value)))
+ ;; Shift element part.
+ (org-element--shift-positions (car value-to-shift) offset)
+ ;; Shift objects part.
+ (dolist (object-data (cdr value-to-shift))
+ (incf (car object-data) offset)
+ (dolist (successor (nth 1 object-data))
+ (incf (cdr successor) offset))
+ (dolist (object (cddr object-data))
+ (org-element--shift-positions object offset)))
+ ;; Shift key-value pair.
+ (let* ((new-key (+ key offset))
+ (new-value (gethash new-key org-element--cache)))
+ ;; Put new value to shifted key.
+ ;;
+ ;; If one already exists, do not overwrite it:
+ ;; store it as the car of a cons cell instead,
+ ;; and handle it when `maphash' reaches
+ ;; NEW-KEY.
+ ;;
+ ;; If there is no element stored at NEW-KEY or
+ ;; if NEW-KEY is going to be removed anyway
+ ;; (i.e., it is before END), just store new
+ ;; value there and make sure it will not be
+ ;; processed again by storing NEW-KEY in
+ ;; NEW-KEYS.
+ (puthash new-key
+ (if (and new-value (> new-key end))
+ (cons value-to-shift new-value)
+ (push new-key new-keys)
+ value-to-shift)
+ org-element--cache)
+ ;; If current value contains two elements, car
+ ;; should be the new value, since cdr has been
+ ;; shifted already.
+ (if conflictp
+ (puthash key (car value) org-element--cache)
+ (remhash key org-element--cache))))))
+ ;; Remove every element between BEG and END, since
+ ;; this is where changes happened.
+ ((>= key beg) (remhash key org-element--cache))
+ ;; Preserve any element ending before BEG. If it
+ ;; overlaps the BEG-END area, remove it.
+ (t (or (< (org-element-property :end (car value)) beg)
+ (remhash key org-element--cache)))))
+ org-element--cache)
+ ;; Signal cache as up-to-date.
+ (org-element--cache-cancel-changes))))))
;;;###autoload
(defun org-element-at-point (&optional keep-trail)
@@ -4687,96 +5097,124 @@ first element of current section."
(if (org-with-limited-levels (org-at-heading-p))
(progn
(beginning-of-line)
- (if (not keep-trail) (org-element-headline-parser (point-max) t)
- (list (org-element-headline-parser (point-max) t))))
+ (let ((headline
+ (or (org-element-cache-get (point) 'element)
+ (car (org-element-cache-put
+ (point)
+ (list (org-element-headline-parser
+ (point-max) t)))))))
+ (if keep-trail (list headline) headline)))
;; Otherwise move at the beginning of the section containing
;; point.
(catch 'exit
- (let ((origin (point))
- (end (save-excursion
- (org-with-limited-levels (outline-next-heading)) (point)))
- element type special-flag trail struct prevs parent)
- (org-with-limited-levels
- (if (org-before-first-heading-p)
- ;; In empty lines at buffer's beginning, return nil.
- (progn (goto-char (point-min))
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- (throw 'exit nil)))
- (org-back-to-heading)
- (forward-line)
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- ;; In blank lines just after the headline, point still
- ;; belongs to the headline.
- (throw 'exit
- (progn (skip-chars-backward " \r\t\n")
- (beginning-of-line)
- (if (not keep-trail)
- (org-element-headline-parser (point-max) t)
- (list (org-element-headline-parser
- (point-max) t))))))))
+ (let ((origin (point)))
+ (if (not (org-with-limited-levels (outline-previous-heading)))
+ ;; In empty lines at buffer's beginning, return nil.
+ (progn (goto-char (point-min))
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ (throw 'exit nil)))
+ (forward-line)
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ ;; In blank lines just after the headline, point still
+ ;; belongs to the headline.
+ (throw 'exit
+ (progn
+ (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ (let ((headline
+ (or (org-element-cache-get (point) 'element)
+ (car (org-element-cache-put
+ (point)
+ (list (org-element-headline-parser
+ (point-max) t)))))))
+ (if keep-trail (list headline) headline))))))
(beginning-of-line)
- ;; Parse successively each element, skipping those ending
- ;; before original position.
- (while t
- (setq element
- (org-element--current-element end 'element special-flag struct)
- type (car element))
- (org-element-put-property element :parent parent)
- (when keep-trail (push element trail))
- (cond
- ;; 1. Skip any element ending before point. Also skip
- ;; element ending at point when we're sure that another
- ;; element has started.
- ((let ((elem-end (org-element-property :end element)))
- (when (or (< elem-end origin)
- (and (= elem-end origin) (/= elem-end end)))
- (goto-char elem-end))))
- ;; 2. An element containing point is always the element at
- ;; point.
- ((not (memq type org-element-greater-elements))
- (throw 'exit (if keep-trail trail element)))
- ;; 3. At any other greater element type, if point is
- ;; within contents, move into it.
- (t
- (let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
- (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
- ;; Create an anchor for tables and plain lists:
- ;; when point is at the very beginning of these
- ;; elements, ignoring affiliated keywords,
- ;; target them instead of their contents.
- (and (= cbeg origin) (memq type '(plain-list table)))
- ;; When point is at contents end, do not move
- ;; into elements with an explicit ending, but
- ;; return that element instead.
- (and (= cend origin)
- (or (memq type
- '(center-block
- drawer dynamic-block inlinetask
- property-drawer quote-block
- special-block))
- ;; Corner case: if a list ends at the
- ;; end of a buffer without a final new
- ;; line, return last element in last
- ;; item instead.
- (and (memq type '(item plain-list))
- (progn (goto-char cend)
- (or (bolp) (not (eobp))))))))
- (throw 'exit (if keep-trail trail element))
- (setq parent element)
- (case type
- (plain-list
- (setq special-flag 'item
- struct (org-element-property :structure element)))
- (item (setq special-flag nil))
- (property-drawer
- (setq special-flag 'node-property struct nil))
- (table (setq special-flag 'table-row struct nil))
- (otherwise (setq special-flag nil struct nil)))
- (setq end cend)
- (goto-char cbeg)))))))))))
+ (let ((end (save-excursion
+ (org-with-limited-levels (outline-next-heading)) (point)))
+ element type special-flag trail struct parent)
+ ;; Parse successively each element, skipping those ending
+ ;; before original position.
+ (while t
+ (setq element
+ (let* ((pos (if (and (memq special-flag '(item table-row))
+ (memq type '(plain-list table)))
+ ;; First item (resp. row) in plain
+ ;; list (resp. table) gets
+ ;; a special key in cache.
+ (1+ (point))
+ (point)))
+ (cached (org-element-cache-get pos 'element)))
+ (cond
+ ((not cached)
+ (let ((element (org-element--current-element
+ end 'element special-flag struct)))
+ (when (derived-mode-p 'org-mode)
+ (org-element-cache-put pos (cons element nil)))
+ element))
+ ;; When changes happened in the middle of a list,
+ ;; its structure ends up being invalid.
+ ;; Therefore, we make sure to use a valid one.
+ ((and struct (memq (car cached) '(item plain-list)))
+ (org-element-put-property cached :structure struct))
+ (t cached))))
+ (setq type (org-element-type element))
+ (org-element-put-property element :parent parent)
+ (when keep-trail (push element trail))
+ (cond
+ ;; 1. Skip any element ending before point. Also skip
+ ;; element ending at point when we're sure that
+ ;; another element has started.
+ ((let ((elem-end (org-element-property :end element)))
+ (when (or (< elem-end origin)
+ (and (= elem-end origin) (/= elem-end end)))
+ (goto-char elem-end))))
+ ;; 2. An element containing point is always the element at
+ ;; point.
+ ((not (memq type org-element-greater-elements))
+ (throw 'exit (if keep-trail trail element)))
+ ;; 3. At any other greater element type, if point is
+ ;; within contents, move into it.
+ (t
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
+ ;; Create an anchor for tables and plain
+ ;; lists: when point is at the very beginning
+ ;; of these elements, ignoring affiliated
+ ;; keywords, target them instead of their
+ ;; contents.
+ (and (= cbeg origin) (memq type '(plain-list table)))
+ ;; When point is at contents end, do not move
+ ;; into elements with an explicit ending, but
+ ;; return that element instead.
+ (and (= cend origin)
+ (or (memq type
+ '(center-block
+ drawer dynamic-block inlinetask
+ property-drawer quote-block
+ special-block))
+ ;; Corner case: if a list ends at
+ ;; the end of a buffer without
+ ;; a final new line, return last
+ ;; element in last item instead.
+ (and (memq type '(item plain-list))
+ (progn (goto-char cend)
+ (or (bolp) (not (eobp))))))))
+ (throw 'exit (if keep-trail trail element))
+ (setq parent element)
+ (case type
+ (plain-list
+ (setq special-flag 'item
+ struct (org-element-property :structure element)))
+ (item (setq special-flag nil))
+ (property-drawer
+ (setq special-flag 'node-property struct nil))
+ (table (setq special-flag 'table-row struct nil))
+ (otherwise (setq special-flag nil struct nil)))
+ (setq end cend)
+ (goto-char cbeg))))))))))))
;;;###autoload
(defun org-element-context (&optional element)
@@ -4798,11 +5236,10 @@ Providing it allows for quicker computation."
(org-with-wide-buffer
(let* ((origin (point))
(element (or element (org-element-at-point)))
- (type (org-element-type element))
- context)
- ;; Check if point is inside an element containing objects or at
- ;; a secondary string. In that case, narrow buffer to the
- ;; containing area. Otherwise, return ELEMENT.
+ (type (org-element-type element)))
+ ;; If point is inside an element containing objects or
+ ;; a secondary string, narrow buffer to the container and
+ ;; proceed with parsing. Otherwise, return ELEMENT.
(cond
;; At a parsed affiliated keyword, check if we're inside main
;; or dual value.
@@ -4832,8 +5269,7 @@ Providing it allows for quicker computation."
(if (and (>= origin (point)) (< origin (match-end 0)))
(narrow-to-region (point) (match-end 0))
(throw 'objects-forbidden element)))))
- ;; At an headline or inlinetask, objects are located within
- ;; their title.
+ ;; At an headline or inlinetask, objects are in title.
((memq type '(headline inlinetask))
(goto-char (org-element-property :begin element))
(skip-chars-forward "* ")
@@ -4859,44 +5295,92 @@ Providing it allows for quicker computation."
(if (and (>= origin (point)) (< origin (line-end-position)))
(narrow-to-region (point) (line-end-position))
(throw 'objects-forbidden element))))
+ ;; All other locations cannot contain objects: bail out.
(t (throw 'objects-forbidden element)))
(goto-char (point-min))
- (let ((restriction (org-element-restriction type))
- (parent element)
- (candidates 'initial))
- (catch 'exit
- (while (setq candidates
- (org-element--get-next-object-candidates
- restriction candidates))
- (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
- candidates)))
- ;; If ORIGIN is before next object in element, there's
- ;; no point in looking further.
- (if (> (cdr closest-cand) origin) (throw 'exit parent)
- (let* ((object
- (progn (goto-char (cdr closest-cand))
- (funcall (intern (format "org-element-%s-parser"
- (car closest-cand))))))
- (cbeg (org-element-property :contents-begin object))
- (cend (org-element-property :contents-end object))
- (obj-end (org-element-property :end object)))
- (cond
- ;; ORIGIN is after OBJECT, so skip it.
- ((<= obj-end origin) (goto-char obj-end))
- ;; ORIGIN is within a non-recursive object or at
- ;; an object boundaries: Return that object.
- ((or (not cbeg) (< origin cbeg) (>= origin cend))
- (throw 'exit
- (org-element-put-property object :parent parent)))
- ;; Otherwise, move within current object and
- ;; restrict search to the end of its contents.
- (t (goto-char cbeg)
- (narrow-to-region (point) cend)
- (org-element-put-property object :parent parent)
- (setq parent object
- restriction (org-element-restriction object)
- candidates 'initial)))))))
- parent))))))
+ (let* ((restriction (org-element-restriction type))
+ (parent element)
+ (candidates 'initial)
+ (cache-key (org-element--cache-get-key element))
+ (cache (org-element-cache-get cache-key 'objects))
+ objects-data next update-cache-flag)
+ (prog1
+ (catch 'exit
+ (while t
+ ;; Get list of next object candidates in CANDIDATES.
+ ;; When entering for the first time PARENT, grab it
+ ;; from cache, if available, or compute it. Then,
+ ;; for each subsequent iteration in PARENT, always
+ ;; compute it since we're beyond cache anyway.
+ (when (and (not next) org-element-use-cache)
+ (let ((data (assq (point) cache)))
+ (if data (setq candidates (nth 1 (setq objects-data data)))
+ (push (setq objects-data (list (point) 'initial))
+ cache))))
+ (when (or next (eq 'initial candidates))
+ (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates))
+ (when org-element-use-cache
+ (setcar (cdr objects-data) candidates)
+ (or update-cache-flag (setq update-cache-flag t))))
+ ;; Compare ORIGIN with next object starting position,
+ ;; if any.
+ ;;
+ ;; If ORIGIN is lesser or if there is no object
+ ;; following, look for a previous object that might
+ ;; contain it in cache. If there is no cache, we
+ ;; didn't miss any object so simply return PARENT.
+ ;;
+ ;; If ORIGIN is greater or equal, parse next
+ ;; candidate for further processing.
+ (let ((closest
+ (and candidates
+ (rassq (apply #'min (mapcar #'cdr candidates))
+ candidates))))
+ (if (or (not closest) (> (cdr closest) origin))
+ (catch 'found
+ (dolist (obj (cddr objects-data) (throw 'exit parent))
+ (when (<= (org-element-property :begin obj) origin)
+ (if (<= (org-element-property :end obj) origin)
+ ;; Object ends before ORIGIN and we
+ ;; know next one in cache starts
+ ;; after it: bail out.
+ (throw 'exit parent)
+ (throw 'found (setq next obj))))))
+ (goto-char (cdr closest))
+ (setq next
+ (funcall (intern (format "org-element-%s-parser"
+ (car closest)))))
+ (when org-element-use-cache
+ (push next (cddr objects-data))
+ (or update-cache-flag (setq update-cache-flag t)))))
+ ;; Process NEXT to know if we need to skip it, return
+ ;; it or move into it.
+ (let ((cbeg (org-element-property :contents-begin next))
+ (cend (org-element-property :contents-end next))
+ (obj-end (org-element-property :end next)))
+ (cond
+ ;; ORIGIN is after NEXT, so skip it.
+ ((<= obj-end origin) (goto-char obj-end))
+ ;; ORIGIN is within a non-recursive next or
+ ;; at an object boundaries: Return that object.
+ ((or (not cbeg) (< origin cbeg) (>= origin cend))
+ (throw 'exit
+ (org-element-put-property next :parent parent)))
+ ;; Otherwise, move into NEXT and reset flags as we
+ ;; shift parent.
+ (t (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (org-element-put-property next :parent parent)
+ (setq parent next
+ restriction (org-element-restriction next)
+ next nil
+ objects-data nil
+ candidates 'initial))))))
+ ;; Update cache if required.
+ (when (and update-cache-flag (derived-mode-p 'org-mode))
+ (org-element-cache-put cache-key (cons element cache)))))))))
(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."
--git a/lisp/org-footnote.el b/lisp/org-footnote.el
index 3c0d97c..c59bd0c 100644
--- a/lisp/org-footnote.el
+++ b/lisp/org-footnote.el
@@ -106,8 +106,15 @@ the notes. However, by hand you may place definitions
*anywhere*.
If this is a string, during export, all subtrees starting with
-this heading will be ignored."
+this heading will be ignored.
+
+If you don't use the customize interface to change this variable,
+you will need to run the following command after the change:
+
+ \\[universal-argument] \\[org-element-cache-reset]"
:group 'org-footnote
+ :initialize 'custom-initialize-set
+ :set (lambda (var val) (set var val) (org-element-cache-reset 'all))
:type '(choice
(string :tag "Collect footnotes under heading")
(const :tag "Define footnotes locally" nil)))
diff --git a/lisp/org-src.el b/lisp/org-src.el
index 6ec3adc..918c1ba 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -116,15 +116,24 @@ These are the regions where each line starts with a colon."
(function :tag "Other (specify)")))
(defcustom org-src-preserve-indentation nil
- "If non-nil preserve leading whitespace characters on export.
-If non-nil leading whitespace characters in source code blocks
-are preserved on export, and when switching between the org
-buffer and the language mode edit buffer. If this variable is nil
-then, after editing with \\[org-edit-src-code], the
-minimum (across-lines) number of leading whitespace characters
-are removed from all lines, and the code block is uniformly
-indented according to the value of `org-edit-src-content-indentation'."
+ "\\<org-mode-map>If non-nil preserve leading whitespace characters on export.
+
+If non-nil leading whitespace characters in source code blocks are
+preserved on export, and when switching between the org buffer and
+the language mode edit buffer.
+
+If this variable is nil then, after editing with \\[org-edit-src-code],
+or \\[org-edit-special], the minimum (across-lines) number of leading whitespace
+characters are removed from all lines, and the code block is uniformly
+indented according to the value of `org-edit-src-content-indentation'.
+
+If you don't use the customize interface to change this variable,
+you will need to run the following command after the change:
+
+ \\[universal-argument] \\[org-element-cache-reset]"
:group 'org-edit-structure
+ :initialize 'custom-initialize-set
+ :set (lambda (var val) (set var val) (org-element-cache-reset 'all))
:type 'boolean)
(defcustom org-edit-src-content-indentation 2
diff --git a/lisp/org.el b/lisp/org.el
index 0fd531d..e331ace 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -140,6 +140,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(declare-function org-element--parse-objects "org-element"
(beg end acc restriction))
(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-cache-reset "org-element" (&optional all))
(declare-function org-element-contents "org-element" (element))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-interpret-data "org-element"
@@ -357,7 +358,8 @@ When MESSAGE is non-nil, display a message with the version."
"Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
(set var value)
(when (featurep 'org)
- (org-load-modules-maybe 'force)))
+ (org-load-modules-maybe 'force)
+ (org-element-cache-reset 'all)))
(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail)
"Modules that should always be loaded together with org.el.
@@ -5391,6 +5393,8 @@ The following commands are available:
(org-setup-filling)
;; Comments.
(org-setup-comments-handling)
+ ;; Initialize cache.
+ (org-element-cache-reset)
;; Beginning/end of defun
(org-set-local 'beginning-of-defun-function 'org-backward-element)
(org-set-local 'end-of-defun-function 'org-forward-element)
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 103ba99..ebf6913 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -858,25 +858,29 @@ Some other text
(ert-deftest test-org-element/headline-archive-tag ()
"Test ARCHIVE tag recognition."
;; Reference test.
- (org-test-with-temp-text "* Headline"
- (let ((org-archive-tag "ARCHIVE"))
- (should-not (org-element-property :archivedp (org-element-at-point)))))
+ (should-not
+ (org-test-with-temp-text "* Headline"
+ (let ((org-archive-tag "ARCHIVE"))
+ (org-element-property :archivedp (org-element-at-point)))))
;; Single tag.
(org-test-with-temp-text "* Headline :ARCHIVE:"
(let ((org-archive-tag "ARCHIVE"))
(let ((headline (org-element-at-point)))
(should (org-element-property :archivedp headline))
;; Test tag removal.
- (should-not (org-element-property :tags headline))))
- (let ((org-archive-tag "Archive"))
- (should-not (org-element-property :archivedp (org-element-at-point)))))
+ (should-not (org-element-property :tags headline)))))
;; Multiple tags.
(org-test-with-temp-text "* Headline :test:ARCHIVE:"
(let ((org-archive-tag "ARCHIVE"))
(let ((headline (org-element-at-point)))
(should (org-element-property :archivedp headline))
;; Test tag removal.
- (should (equal (org-element-property :tags headline) '("test")))))))
+ (should (equal (org-element-property :tags headline) '("test"))))))
+ ;; Tag is case-sensitive.
+ (should-not
+ (org-test-with-temp-text "* Headline :ARCHIVE:"
+ (let ((org-archive-tag "Archive"))
+ (org-element-property :archivedp (org-element-at-point))))))
(ert-deftest test-org-element/headline-properties ()
"Test properties from property drawer."
--
1.8.4.1
^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [RFC] Simple cache mechanism for `org-element-at-point'
2013-10-27 8:52 ` Nicolas Goaziou
@ 2013-10-30 10:06 ` Nicolas Goaziou
2013-10-30 12:39 ` Eric Abrahamsen
0 siblings, 1 reply; 9+ messages in thread
From: Nicolas Goaziou @ 2013-10-30 10:06 UTC (permalink / raw)
To: Org Mode List; +Cc: Carsten Dominik
Nicolas Goaziou <n.goaziou@gmail.com> writes:
> Here is a slight change to the second one, which will correctly reset
> cache when some variables are customized or when a buffer is refreshed
> (C-c C-c on a keyword).
By the way, almost a month has passed since the first message in this
thread. Is someone still testing, or reviewing, it? I know it is
a non-trivial and quite sensitive change, so if one needs more time to
evaluate it, I certainly can wait more.
Otherwise, it might be better to simply apply it on master and cope with
the bugs.
WDYT?
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [RFC] Simple cache mechanism for `org-element-at-point'
2013-10-30 10:06 ` Nicolas Goaziou
@ 2013-10-30 12:39 ` Eric Abrahamsen
2013-11-03 12:39 ` Nicolas Goaziou
0 siblings, 1 reply; 9+ messages in thread
From: Eric Abrahamsen @ 2013-10-30 12:39 UTC (permalink / raw)
To: emacs-orgmode
Nicolas Goaziou <n.goaziou@gmail.com> writes:
> Nicolas Goaziou <n.goaziou@gmail.com> writes:
>
>> Here is a slight change to the second one, which will correctly reset
>> cache when some variables are customized or when a buffer is refreshed
>> (C-c C-c on a keyword).
>
> By the way, almost a month has passed since the first message in this
> thread. Is someone still testing, or reviewing, it? I know it is
> a non-trivial and quite sensitive change, so if one needs more time to
> evaluate it, I certainly can wait more.
>
> Otherwise, it might be better to simply apply it on master and cope with
> the bugs.
I wasn't expecting to report back anything meaningful on this issue
unless I saw a bug or problem. I've done quite a bit of day-to-day using
these patches -- editing, agenda stuff, and exporting -- with no
noticeable ill effects... so there's my report!
E
^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [RFC] Simple cache mechanism for `org-element-at-point'
2013-10-30 12:39 ` Eric Abrahamsen
@ 2013-11-03 12:39 ` Nicolas Goaziou
0 siblings, 0 replies; 9+ messages in thread
From: Nicolas Goaziou @ 2013-11-03 12:39 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: emacs-orgmode
Hello,
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> I wasn't expecting to report back anything meaningful on this issue
> unless I saw a bug or problem. I've done quite a bit of day-to-day using
> these patches -- editing, agenda stuff, and exporting -- with no
> noticeable ill effects... so there's my report!
Thank you very much for testing it. I pushed it on master branch.
Hopefully, the more functions use `org-element-at-point' and
`org-element-context', the more it will be beneficial.
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2013-11-03 12:38 UTC | newest]
Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-10-03 21:18 [RFC] Simple cache mechanism for `org-element-at-point' Nicolas Goaziou
2013-10-04 5:43 ` Eric Abrahamsen
2013-10-04 8:53 ` Nicolas Goaziou
2013-10-04 9:13 ` Carsten Dominik
2013-10-04 17:15 ` Nicolas Goaziou
2013-10-27 8:52 ` Nicolas Goaziou
2013-10-30 10:06 ` Nicolas Goaziou
2013-10-30 12:39 ` Eric Abrahamsen
2013-11-03 12:39 ` Nicolas Goaziou
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).