forked from mirrors/org-mode
Merge branch 'master' of orgmode.org:org-mode
This commit is contained in:
commit
24ff0f355d
|
@ -111,7 +111,8 @@
|
||||||
;;
|
;;
|
||||||
;; The library ends by furnishing `org-element-at-point' function, and
|
;; The library ends by furnishing `org-element-at-point' function, and
|
||||||
;; a way to give information about document structure around point
|
;; 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:
|
;;; 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
|
;; 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
|
;; containing point. This is the job of `org-element-at-point'. It
|
||||||
;; basically jumps back to the beginning of section containing point
|
;; 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:
|
;; `org-element--current-element' until the container is found. Note:
|
||||||
;; When using `org-element-at-point', secondary values are never
|
;; When using `org-element-at-point', secondary values are never
|
||||||
;; parsed since the function focuses on elements, not on objects.
|
;; 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
|
;; At a deeper level, `org-element-context' lists all elements and
|
||||||
;; objects containing point.
|
;; objects containing point.
|
||||||
;;
|
;;
|
||||||
;; `org-element-nested-p' and `org-element-swap-A-B' may be used
|
;; Both functions benefit from a simple caching mechanism. It is
|
||||||
;; internally by navigation and manipulation tools.
|
;; 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
|
;;;###autoload
|
||||||
(defun org-element-at-point (&optional keep-trail)
|
(defun org-element-at-point (&optional keep-trail)
|
||||||
|
@ -4659,48 +5069,75 @@ first element of current section."
|
||||||
(if (org-with-limited-levels (org-at-heading-p))
|
(if (org-with-limited-levels (org-at-heading-p))
|
||||||
(progn
|
(progn
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(if (not keep-trail) (org-element-headline-parser (point-max) t)
|
(let ((headline
|
||||||
(list (org-element-headline-parser (point-max) t))))
|
(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
|
;; Otherwise move at the beginning of the section containing
|
||||||
;; point.
|
;; point.
|
||||||
(catch 'exit
|
(catch 'exit
|
||||||
(let ((origin (point))
|
(let ((origin (point)))
|
||||||
(end (save-excursion
|
(if (not (org-with-limited-levels (outline-previous-heading)))
|
||||||
(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.
|
;; In empty lines at buffer's beginning, return nil.
|
||||||
(progn (goto-char (point-min))
|
(progn (goto-char (point-min))
|
||||||
(org-skip-whitespace)
|
(org-skip-whitespace)
|
||||||
(when (or (eobp) (> (line-beginning-position) origin))
|
(when (or (eobp) (> (line-beginning-position) origin))
|
||||||
(throw 'exit nil)))
|
(throw 'exit nil)))
|
||||||
(org-back-to-heading)
|
|
||||||
(forward-line)
|
(forward-line)
|
||||||
(org-skip-whitespace)
|
(org-skip-whitespace)
|
||||||
(when (or (eobp) (> (line-beginning-position) origin))
|
(when (or (eobp) (> (line-beginning-position) origin))
|
||||||
;; In blank lines just after the headline, point still
|
;; In blank lines just after the headline, point still
|
||||||
;; belongs to the headline.
|
;; belongs to the headline.
|
||||||
(throw 'exit
|
(throw 'exit
|
||||||
(progn (skip-chars-backward " \r\t\n")
|
(progn
|
||||||
|
(skip-chars-backward " \r\t\n")
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(if (not keep-trail)
|
(let ((headline
|
||||||
(org-element-headline-parser (point-max) t)
|
(or (org-element-cache-get (point) 'element)
|
||||||
|
(car (org-element-cache-put
|
||||||
|
(point)
|
||||||
(list (org-element-headline-parser
|
(list (org-element-headline-parser
|
||||||
(point-max) t))))))))
|
(point-max) t)))))))
|
||||||
|
(if keep-trail (list headline) headline))))))
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
|
(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
|
;; Parse successively each element, skipping those ending
|
||||||
;; before original position.
|
;; before original position.
|
||||||
(while t
|
(while t
|
||||||
(setq element
|
(setq element
|
||||||
(org-element--current-element end 'element special-flag struct)
|
(let* ((pos (if (and (memq special-flag '(item table-row))
|
||||||
type (car element))
|
(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)
|
(org-element-put-property element :parent parent)
|
||||||
(when keep-trail (push element trail))
|
(when keep-trail (push element trail))
|
||||||
(cond
|
(cond
|
||||||
;; 1. Skip any element ending before point. Also skip
|
;; 1. Skip any element ending before point. Also skip
|
||||||
;; element ending at point when we're sure that another
|
;; element ending at point when we're sure that
|
||||||
;; element has started.
|
;; another element has started.
|
||||||
((let ((elem-end (org-element-property :end element)))
|
((let ((elem-end (org-element-property :end element)))
|
||||||
(when (or (< elem-end origin)
|
(when (or (< elem-end origin)
|
||||||
(and (= elem-end origin) (/= elem-end end)))
|
(and (= elem-end origin) (/= elem-end end)))
|
||||||
|
@ -4715,10 +5152,11 @@ first element of current section."
|
||||||
(let ((cbeg (org-element-property :contents-begin element))
|
(let ((cbeg (org-element-property :contents-begin element))
|
||||||
(cend (org-element-property :contents-end element)))
|
(cend (org-element-property :contents-end element)))
|
||||||
(if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
|
(if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
|
||||||
;; Create an anchor for tables and plain lists:
|
;; Create an anchor for tables and plain
|
||||||
;; when point is at the very beginning of these
|
;; lists: when point is at the very beginning
|
||||||
;; elements, ignoring affiliated keywords,
|
;; of these elements, ignoring affiliated
|
||||||
;; target them instead of their contents.
|
;; keywords, target them instead of their
|
||||||
|
;; contents.
|
||||||
(and (= cbeg origin) (memq type '(plain-list table)))
|
(and (= cbeg origin) (memq type '(plain-list table)))
|
||||||
;; When point is at contents end, do not move
|
;; When point is at contents end, do not move
|
||||||
;; into elements with an explicit ending, but
|
;; into elements with an explicit ending, but
|
||||||
|
@ -4729,10 +5167,10 @@ first element of current section."
|
||||||
drawer dynamic-block inlinetask
|
drawer dynamic-block inlinetask
|
||||||
property-drawer quote-block
|
property-drawer quote-block
|
||||||
special-block))
|
special-block))
|
||||||
;; Corner case: if a list ends at the
|
;; Corner case: if a list ends at
|
||||||
;; end of a buffer without a final new
|
;; the end of a buffer without
|
||||||
;; line, return last element in last
|
;; a final new line, return last
|
||||||
;; item instead.
|
;; element in last item instead.
|
||||||
(and (memq type '(item plain-list))
|
(and (memq type '(item plain-list))
|
||||||
(progn (goto-char cend)
|
(progn (goto-char cend)
|
||||||
(or (bolp) (not (eobp))))))))
|
(or (bolp) (not (eobp))))))))
|
||||||
|
@ -4748,7 +5186,7 @@ first element of current section."
|
||||||
(table (setq special-flag 'table-row struct nil))
|
(table (setq special-flag 'table-row struct nil))
|
||||||
(otherwise (setq special-flag nil struct nil)))
|
(otherwise (setq special-flag nil struct nil)))
|
||||||
(setq end cend)
|
(setq end cend)
|
||||||
(goto-char cbeg)))))))))))
|
(goto-char cbeg))))))))))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun org-element-context (&optional element)
|
(defun org-element-context (&optional element)
|
||||||
|
@ -4770,11 +5208,10 @@ Providing it allows for quicker computation."
|
||||||
(org-with-wide-buffer
|
(org-with-wide-buffer
|
||||||
(let* ((origin (point))
|
(let* ((origin (point))
|
||||||
(element (or element (org-element-at-point)))
|
(element (or element (org-element-at-point)))
|
||||||
(type (org-element-type element))
|
(type (org-element-type element)))
|
||||||
context)
|
;; If point is inside an element containing objects or
|
||||||
;; Check if point is inside an element containing objects or at
|
;; a secondary string, narrow buffer to the container and
|
||||||
;; a secondary string. In that case, narrow buffer to the
|
;; proceed with parsing. Otherwise, return ELEMENT.
|
||||||
;; containing area. Otherwise, return ELEMENT.
|
|
||||||
(cond
|
(cond
|
||||||
;; At a parsed affiliated keyword, check if we're inside main
|
;; At a parsed affiliated keyword, check if we're inside main
|
||||||
;; or dual value.
|
;; or dual value.
|
||||||
|
@ -4804,8 +5241,7 @@ Providing it allows for quicker computation."
|
||||||
(if (and (>= origin (point)) (< origin (match-end 0)))
|
(if (and (>= origin (point)) (< origin (match-end 0)))
|
||||||
(narrow-to-region (point) (match-end 0))
|
(narrow-to-region (point) (match-end 0))
|
||||||
(throw 'objects-forbidden element)))))
|
(throw 'objects-forbidden element)))))
|
||||||
;; At an headline or inlinetask, objects are located within
|
;; At an headline or inlinetask, objects are in title.
|
||||||
;; their title.
|
|
||||||
((memq type '(headline inlinetask))
|
((memq type '(headline inlinetask))
|
||||||
(goto-char (org-element-property :begin element))
|
(goto-char (org-element-property :begin element))
|
||||||
(skip-chars-forward "* ")
|
(skip-chars-forward "* ")
|
||||||
|
@ -4831,44 +5267,92 @@ Providing it allows for quicker computation."
|
||||||
(if (and (>= origin (point)) (< origin (line-end-position)))
|
(if (and (>= origin (point)) (< origin (line-end-position)))
|
||||||
(narrow-to-region (point) (line-end-position))
|
(narrow-to-region (point) (line-end-position))
|
||||||
(throw 'objects-forbidden element))))
|
(throw 'objects-forbidden element))))
|
||||||
|
;; All other locations cannot contain objects: bail out.
|
||||||
(t (throw 'objects-forbidden element)))
|
(t (throw 'objects-forbidden element)))
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(let ((restriction (org-element-restriction type))
|
(let* ((restriction (org-element-restriction type))
|
||||||
(parent element)
|
(parent element)
|
||||||
(candidates 'initial))
|
(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
|
(catch 'exit
|
||||||
(while (setq candidates
|
(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
|
(org-element--get-next-object-candidates
|
||||||
restriction candidates))
|
restriction candidates))
|
||||||
(let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
|
(when org-element-use-cache
|
||||||
candidates)))
|
(setcar (cdr objects-data) candidates)
|
||||||
;; If ORIGIN is before next object in element, there's
|
(or update-cache-flag (setq update-cache-flag t))))
|
||||||
;; no point in looking further.
|
;; Compare ORIGIN with next object starting position,
|
||||||
(if (> (cdr closest-cand) origin) (throw 'exit parent)
|
;; if any.
|
||||||
(let* ((object
|
;;
|
||||||
(progn (goto-char (cdr closest-cand))
|
;; 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"
|
(funcall (intern (format "org-element-%s-parser"
|
||||||
(car closest-cand))))))
|
(car closest)))))
|
||||||
(cbeg (org-element-property :contents-begin object))
|
(when org-element-use-cache
|
||||||
(cend (org-element-property :contents-end object))
|
(push next (cddr objects-data))
|
||||||
(obj-end (org-element-property :end object)))
|
(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
|
(cond
|
||||||
;; ORIGIN is after OBJECT, so skip it.
|
;; ORIGIN is after NEXT, so skip it.
|
||||||
((<= obj-end origin) (goto-char obj-end))
|
((<= obj-end origin) (goto-char obj-end))
|
||||||
;; ORIGIN is within a non-recursive object or at
|
;; ORIGIN is within a non-recursive next or
|
||||||
;; an object boundaries: Return that object.
|
;; at an object boundaries: Return that object.
|
||||||
((or (not cbeg) (< origin cbeg) (>= origin cend))
|
((or (not cbeg) (< origin cbeg) (>= origin cend))
|
||||||
(throw 'exit
|
(throw 'exit
|
||||||
(org-element-put-property object :parent parent)))
|
(org-element-put-property next :parent parent)))
|
||||||
;; Otherwise, move within current object and
|
;; Otherwise, move into NEXT and reset flags as we
|
||||||
;; restrict search to the end of its contents.
|
;; shift parent.
|
||||||
(t (goto-char cbeg)
|
(t (goto-char cbeg)
|
||||||
(narrow-to-region (point) cend)
|
(narrow-to-region (point) cend)
|
||||||
(org-element-put-property object :parent parent)
|
(org-element-put-property next :parent parent)
|
||||||
(setq parent object
|
(setq parent next
|
||||||
restriction (org-element-restriction object)
|
restriction (org-element-restriction next)
|
||||||
candidates 'initial)))))))
|
next nil
|
||||||
parent))))))
|
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)
|
(defun org-element-nested-p (elem-A elem-B)
|
||||||
"Non-nil when elements ELEM-A and ELEM-B are nested."
|
"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*.
|
*anywhere*.
|
||||||
|
|
||||||
If this is a string, during export, all subtrees starting with
|
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
|
:group 'org-footnote
|
||||||
|
:initialize 'custom-initialize-set
|
||||||
|
:set (lambda (var val) (set var val) (org-element-cache-reset 'all))
|
||||||
:type '(choice
|
:type '(choice
|
||||||
(string :tag "Collect footnotes under heading")
|
(string :tag "Collect footnotes under heading")
|
||||||
(const :tag "Define footnotes locally" nil)))
|
(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"
|
(declare-function org-element--parse-objects "org-element"
|
||||||
(beg end acc restriction))
|
(beg end acc restriction))
|
||||||
(declare-function org-element-at-point "org-element" (&optional keep-trail))
|
(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-contents "org-element" (element))
|
||||||
(declare-function org-element-context "org-element" (&optional element))
|
(declare-function org-element-context "org-element" (&optional element))
|
||||||
(declare-function org-element-interpret-data "org-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 to VALUE and call `org-load-modules-maybe' with the force flag."
|
||||||
(set var value)
|
(set var value)
|
||||||
(when (featurep 'org)
|
(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)
|
(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.
|
"Modules that should always be loaded together with org.el.
|
||||||
|
@ -5367,6 +5369,8 @@ The following commands are available:
|
||||||
(org-setup-filling)
|
(org-setup-filling)
|
||||||
;; Comments.
|
;; Comments.
|
||||||
(org-setup-comments-handling)
|
(org-setup-comments-handling)
|
||||||
|
;; Initialize cache.
|
||||||
|
(org-element-cache-reset)
|
||||||
;; Beginning/end of defun
|
;; Beginning/end of defun
|
||||||
(org-set-local 'beginning-of-defun-function 'org-backward-element)
|
(org-set-local 'beginning-of-defun-function 'org-backward-element)
|
||||||
(org-set-local 'end-of-defun-function 'org-forward-element)
|
(org-set-local 'end-of-defun-function 'org-forward-element)
|
||||||
|
@ -10520,7 +10524,8 @@ application the system uses for this file type."
|
||||||
((and (string= type "thisfile")
|
((and (string= type "thisfile")
|
||||||
(or (run-hook-with-args-until-success
|
(or (run-hook-with-args-until-success
|
||||||
'org-open-link-functions path)
|
'org-open-link-functions path)
|
||||||
(and (string-match "^id:" link)
|
(and link
|
||||||
|
(string-match "^id:" link)
|
||||||
(or (featurep 'org-id) (require 'org-id))
|
(or (featurep 'org-id) (require 'org-id))
|
||||||
(progn
|
(progn
|
||||||
(funcall (nth 1 (assoc "id" org-link-protocols))
|
(funcall (nth 1 (assoc "id" org-link-protocols))
|
||||||
|
|
|
@ -847,25 +847,29 @@ Some other text
|
||||||
(ert-deftest test-org-element/headline-archive-tag ()
|
(ert-deftest test-org-element/headline-archive-tag ()
|
||||||
"Test ARCHIVE tag recognition."
|
"Test ARCHIVE tag recognition."
|
||||||
;; Reference test.
|
;; Reference test.
|
||||||
|
(should-not
|
||||||
(org-test-with-temp-text "* Headline"
|
(org-test-with-temp-text "* Headline"
|
||||||
(let ((org-archive-tag "ARCHIVE"))
|
(let ((org-archive-tag "ARCHIVE"))
|
||||||
(should-not (org-element-property :archivedp (org-element-at-point)))))
|
(org-element-property :archivedp (org-element-at-point)))))
|
||||||
;; Single tag.
|
;; Single tag.
|
||||||
(org-test-with-temp-text "* Headline :ARCHIVE:"
|
(org-test-with-temp-text "* Headline :ARCHIVE:"
|
||||||
(let ((org-archive-tag "ARCHIVE"))
|
(let ((org-archive-tag "ARCHIVE"))
|
||||||
(let ((headline (org-element-at-point)))
|
(let ((headline (org-element-at-point)))
|
||||||
(should (org-element-property :archivedp headline))
|
(should (org-element-property :archivedp headline))
|
||||||
;; Test tag removal.
|
;; Test tag removal.
|
||||||
(should-not (org-element-property :tags headline))))
|
(should-not (org-element-property :tags headline)))))
|
||||||
(let ((org-archive-tag "Archive"))
|
|
||||||
(should-not (org-element-property :archivedp (org-element-at-point)))))
|
|
||||||
;; Multiple tags.
|
;; Multiple tags.
|
||||||
(org-test-with-temp-text "* Headline :test:ARCHIVE:"
|
(org-test-with-temp-text "* Headline :test:ARCHIVE:"
|
||||||
(let ((org-archive-tag "ARCHIVE"))
|
(let ((org-archive-tag "ARCHIVE"))
|
||||||
(let ((headline (org-element-at-point)))
|
(let ((headline (org-element-at-point)))
|
||||||
(should (org-element-property :archivedp headline))
|
(should (org-element-property :archivedp headline))
|
||||||
;; Test tag removal.
|
;; 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 ()
|
(ert-deftest test-org-element/headline-properties ()
|
||||||
"Test properties from property drawer."
|
"Test properties from property drawer."
|
||||||
|
|
Loading…
Reference in a new issue