|
|
@@ -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."
|
Nicolas Goaziou