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. * 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'.
This commit is contained in:
Nicolas Goaziou
parent
1bf67e2903
commit
0cecf32a0a
|
|
@ -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:
|
||||
|
|
@ -4618,7 +4619,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.
|
||||
|
|
@ -4626,8 +4627,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)
|
||||
|
|
@ -4659,96 +5069,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)
|
||||
|
|
@ -4770,11 +5208,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.
|
||||
|
|
@ -4804,8 +5241,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 "* ")
|
||||
|
|
@ -4831,44 +5267,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."
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
@ -5367,6 +5369,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)
|
||||
|
|
|
|||
|
|
@ -847,25 +847,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."
|
||||
|
|
|
|||
Loading…
Reference in New Issue