|
@@ -119,6 +119,7 @@
|
|
|
|
|
|
(eval-when-compile (require 'cl))
|
|
|
(require 'org)
|
|
|
+(require 'avl-tree)
|
|
|
|
|
|
|
|
|
|
|
@@ -4710,64 +4711,449 @@ indentation is not done with TAB characters."
|
|
|
;; At a deeper level, `org-element-context' lists all elements and
|
|
|
;; objects containing point.
|
|
|
;;
|
|
|
-;; 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.")
|
|
|
+;; `org-element-nested-p' and `org-element-swap-A-B' may be used
|
|
|
+;; internally by navigation and manipulation tools.
|
|
|
|
|
|
-(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:
|
|
|
+;;;###autoload
|
|
|
+(defun org-element-at-point ()
|
|
|
+ "Determine closest element around point.
|
|
|
|
|
|
- \(POS CANDIDATES . OBJECTS)
|
|
|
+Return value is a list like (TYPE PROPS) where TYPE is the type
|
|
|
+of the element and PROPS a plist of properties associated to the
|
|
|
+element.
|
|
|
|
|
|
-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.
|
|
|
+Possible types are defined in `org-element-all-elements'.
|
|
|
+Properties depend on element or object type, but always include
|
|
|
+`:begin', `:end', `:parent' and `:post-blank' properties.
|
|
|
|
|
|
-In the following example, \\alpha, bold object and \\beta start
|
|
|
-at, respectively, positions 1, 7 and 8,
|
|
|
+As a special case, if point is at the very beginning of the first
|
|
|
+item in a list or sub-list, returned element will be that list
|
|
|
+instead of the item. Likewise, if point is at the beginning of
|
|
|
+the first row of a table, returned element will be the table
|
|
|
+instead of the first row.
|
|
|
|
|
|
- \\alpha *\\beta*
|
|
|
+When point is at the end of the buffer, return the innermost
|
|
|
+element ending there."
|
|
|
+ (catch 'exit
|
|
|
+ (org-with-wide-buffer
|
|
|
+ (let ((origin (point)) element next)
|
|
|
+ (end-of-line)
|
|
|
+ (skip-chars-backward " \r\t\n")
|
|
|
+ (cond
|
|
|
+ ;; Within blank lines at the beginning of buffer, return nil.
|
|
|
+ ((bobp) (throw 'exit nil))
|
|
|
+ ;; Within blank lines right after a headline, return that
|
|
|
+ ;; headline.
|
|
|
+ ((org-with-limited-levels (org-at-heading-p))
|
|
|
+ (beginning-of-line)
|
|
|
+ (throw 'exit (org-element-headline-parser (point-max) t))))
|
|
|
+ ;; Otherwise use cache in order to approximate current element.
|
|
|
+ (goto-char origin)
|
|
|
+ (let* ((cached (org-element-cache-get origin))
|
|
|
+ (begin (org-element-property :begin cached)))
|
|
|
+ (cond
|
|
|
+ ;; Nothing in cache before point: start parsing from first
|
|
|
+ ;; element following headline above, or first element in
|
|
|
+ ;; buffer.
|
|
|
+ ((not cached)
|
|
|
+ (org-with-limited-levels (outline-previous-heading)
|
|
|
+ (when (org-at-heading-p) (forward-line)))
|
|
|
+ (skip-chars-forward " \r\t\n")
|
|
|
+ (beginning-of-line))
|
|
|
+ ;; Cache returned exact match: return it.
|
|
|
+ ((= origin begin) (throw 'exit cached))
|
|
|
+ ;; There's a headline between cached value and ORIGIN:
|
|
|
+ ;; cached value is invalid. Start parsing from first
|
|
|
+ ;; element following the headline.
|
|
|
+ ((re-search-backward
|
|
|
+ (org-with-limited-levels org-outline-regexp-bol) begin t)
|
|
|
+ (forward-line)
|
|
|
+ (skip-chars-forward " \r\t\n")
|
|
|
+ (beginning-of-line))
|
|
|
+ ;; Check if CACHED or any of its ancestors contain point.
|
|
|
+ ;;
|
|
|
+ ;; If there is such an element, we inspect it in order to
|
|
|
+ ;; know if we return it or if we need to parse its contents.
|
|
|
+ ;; Otherwise, we just start parsing from current location,
|
|
|
+ ;; which is right after the top-most element containing
|
|
|
+ ;; CACHED.
|
|
|
+ ;;
|
|
|
+ ;; As a special case, if ORIGIN is at the end of the buffer,
|
|
|
+ ;; we want to return the innermost element ending there.
|
|
|
+ ;;
|
|
|
+ ;; Also, if we find an ancestor and discover that we need to
|
|
|
+ ;; parse its contents, make sure we don't start from
|
|
|
+ ;; `:contents-begin', as we would otherwise go past CACHED
|
|
|
+ ;; again. Instead, in that situation, we will resume
|
|
|
+ ;; parsing from NEXT, which is located after CACHED or its
|
|
|
+ ;; higher ancestor not containing point.
|
|
|
+ (t
|
|
|
+ (let ((up cached))
|
|
|
+ (goto-char (or (org-element-property :contents-begin cached)
|
|
|
+ begin))
|
|
|
+ (while (and up
|
|
|
+ (not (eobp))
|
|
|
+ (<= (org-element-property :end up) origin))
|
|
|
+ (goto-char (org-element-property :end up))
|
|
|
+ (setq up (org-element-property :parent up)))
|
|
|
+ (cond ((not up))
|
|
|
+ ((eobp) (setq element up))
|
|
|
+ (t (setq element up next (point))))))))
|
|
|
+ ;; Parse successively each element until we reach ORIGIN.
|
|
|
+ (let ((end (or (org-element-property
|
|
|
+ :contents-end (org-element-property :parent element))
|
|
|
+ (save-excursion
|
|
|
+ (org-with-limited-levels (outline-next-heading))
|
|
|
+ (point))))
|
|
|
+ parent special-flag)
|
|
|
+ (while t
|
|
|
+ (unless element
|
|
|
+ (let ((e (org-element--current-element
|
|
|
+ end 'element special-flag
|
|
|
+ (org-element-property :structure parent))))
|
|
|
+ (org-element-put-property e :parent parent)
|
|
|
+ (setq element (org-element-cache-put e))))
|
|
|
+ (let ((elem-end (org-element-property :end element))
|
|
|
+ (type (org-element-type element)))
|
|
|
+ (cond
|
|
|
+ ;; Special case: ORIGIN is at the end of the buffer and
|
|
|
+ ;; CACHED ends here. No element can start after it, but
|
|
|
+ ;; more than one may end there. Arbitrarily, we choose
|
|
|
+ ;; to return the innermost of such elements.
|
|
|
+ ((and (= (point-max) origin) (= origin elem-end))
|
|
|
+ (let ((cend (org-element-property :contents-end element)))
|
|
|
+ (if (or (not (memq type org-element-greater-elements))
|
|
|
+ (not cend)
|
|
|
+ (< cend origin))
|
|
|
+ (throw 'exit element)
|
|
|
+ (goto-char
|
|
|
+ (or next (org-element-property :contents-begin element)))
|
|
|
+ (setq special-flag (case type
|
|
|
+ (plain-list 'item)
|
|
|
+ (property-drawer 'node-property)
|
|
|
+ (table 'table-row))
|
|
|
+ parent element
|
|
|
+ end cend))))
|
|
|
+ ;; Skip any element ending before point. Also skip
|
|
|
+ ;; element ending at point since we're sure that another
|
|
|
+ ;; element begins after it.
|
|
|
+ ((<= elem-end origin) (goto-char elem-end))
|
|
|
+ ;; A non-greater element contains point: return it.
|
|
|
+ ((not (memq type org-element-greater-elements))
|
|
|
+ (throw 'exit element))
|
|
|
+ ;; Otherwise, we have to decide if ELEMENT really
|
|
|
+ ;; contains ORIGIN. In that case we start parsing from
|
|
|
+ ;; contents' beginning. Otherwise we return UP as it is
|
|
|
+ ;; the smallest element containing ORIGIN.
|
|
|
+ ;;
|
|
|
+ ;; There is a special cases to consider, though. If
|
|
|
+ ;; ORIGIN is at contents' beginning but it is also at
|
|
|
+ ;; the beginning of the first item in a list or a table.
|
|
|
+ ;; In that case, we need to create an anchor for that
|
|
|
+ ;; list or table, so return it.
|
|
|
+ (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)
|
|
|
+ (and (= cbeg origin) (memq type '(plain-list table))))
|
|
|
+ (throw 'exit element)
|
|
|
+ (goto-char (or next cbeg))
|
|
|
+ (setq special-flag (case type
|
|
|
+ (plain-list 'item)
|
|
|
+ (property-drawer 'node-property)
|
|
|
+ (table 'table-row))
|
|
|
+ parent element
|
|
|
+ end cend))))))
|
|
|
+ ;; Continue parsing buffer contents from new position.
|
|
|
+ (setq element nil next nil)))))))
|
|
|
|
|
|
-If the paragraph is completely parsed, OBJECTS-DATA will be
|
|
|
+;;;###autoload
|
|
|
+(defun org-element-context (&optional element)
|
|
|
+ "Return closest element or object around point.
|
|
|
|
|
|
- \((1 nil BOLD-OBJECT ENTITY-OBJECT)
|
|
|
- \(8 nil ENTITY-OBJECT))
|
|
|
+Return value is a list like (TYPE PROPS) where TYPE is the type
|
|
|
+of the element or object and PROPS a plist of properties
|
|
|
+associated to it.
|
|
|
|
|
|
-whereas in a partially parsed paragraph, it could be
|
|
|
+Possible types are defined in `org-element-all-elements' and
|
|
|
+`org-element-all-objects'. Properties depend on element or
|
|
|
+object type, but always include `:begin', `:end', `:parent' and
|
|
|
+`:post-blank'.
|
|
|
|
|
|
- \((1 ((entity . 1) (bold . 7)) ENTITY-OBJECT))
|
|
|
+Optional argument ELEMENT, when non-nil, is the closest element
|
|
|
+containing point, as returned by `org-element-at-point'.
|
|
|
+Providing it allows for quicker computation."
|
|
|
+ (catch 'objects-forbidden
|
|
|
+ (org-with-wide-buffer
|
|
|
+ (let* ((origin (point))
|
|
|
+ (element (or element (org-element-at-point)))
|
|
|
+ (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.
|
|
|
+ ((let ((post (org-element-property :post-affiliated element)))
|
|
|
+ (and post (< origin post)))
|
|
|
+ (beginning-of-line)
|
|
|
+ (let ((case-fold-search t)) (looking-at org-element--affiliated-re))
|
|
|
+ (cond
|
|
|
+ ((not (member-ignore-case (match-string 1)
|
|
|
+ org-element-parsed-keywords))
|
|
|
+ (throw 'objects-forbidden element))
|
|
|
+ ((< (match-end 0) origin)
|
|
|
+ (narrow-to-region (match-end 0) (line-end-position)))
|
|
|
+ ((and (match-beginning 2)
|
|
|
+ (>= origin (match-beginning 2))
|
|
|
+ (< origin (match-end 2)))
|
|
|
+ (narrow-to-region (match-beginning 2) (match-end 2)))
|
|
|
+ (t (throw 'objects-forbidden element)))
|
|
|
+ ;; Also change type to retrieve correct restrictions.
|
|
|
+ (setq type 'keyword))
|
|
|
+ ;; At an item, objects can only be located within tag, if any.
|
|
|
+ ((eq type 'item)
|
|
|
+ (let ((tag (org-element-property :tag element)))
|
|
|
+ (if (not tag) (throw 'objects-forbidden element)
|
|
|
+ (beginning-of-line)
|
|
|
+ (search-forward tag (line-end-position))
|
|
|
+ (goto-char (match-beginning 0))
|
|
|
+ (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 in title.
|
|
|
+ ((memq type '(headline inlinetask))
|
|
|
+ (goto-char (org-element-property :begin element))
|
|
|
+ (skip-chars-forward "* ")
|
|
|
+ (if (and (>= origin (point)) (< origin (line-end-position)))
|
|
|
+ (narrow-to-region (point) (line-end-position))
|
|
|
+ (throw 'objects-forbidden element)))
|
|
|
+ ;; At a paragraph, a table-row or a verse block, objects are
|
|
|
+ ;; located within their contents.
|
|
|
+ ((memq type '(paragraph table-row verse-block))
|
|
|
+ (let ((cbeg (org-element-property :contents-begin element))
|
|
|
+ (cend (org-element-property :contents-end element)))
|
|
|
+ ;; CBEG is nil for table rules.
|
|
|
+ (if (and cbeg cend (>= origin cbeg) (< origin cend))
|
|
|
+ (narrow-to-region cbeg cend)
|
|
|
+ (throw 'objects-forbidden element))))
|
|
|
+ ;; At a parsed keyword, objects are located within value.
|
|
|
+ ((eq type 'keyword)
|
|
|
+ (if (not (member (org-element-property :key element)
|
|
|
+ org-element-document-properties))
|
|
|
+ (throw 'objects-forbidden element)
|
|
|
+ (beginning-of-line)
|
|
|
+ (search-forward ":")
|
|
|
+ (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)
|
|
|
+ (cache (org-element-cache-get element))
|
|
|
+ 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.
|
|
|
+ (unless next
|
|
|
+ (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))
|
|
|
+ (setcar (cdr objects-data) candidates))
|
|
|
+ ;; 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)))))
|
|
|
+ (push next (cddr objects-data))))
|
|
|
+ ;; 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))))))
|
|
|
+ ;; Store results in cache, if applicable.
|
|
|
+ (org-element-cache-put cache element)))))))
|
|
|
|
|
|
-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.")
|
|
|
+(defun org-element-nested-p (elem-A elem-B)
|
|
|
+ "Non-nil when elements ELEM-A and ELEM-B are nested."
|
|
|
+ (let ((beg-A (org-element-property :begin elem-A))
|
|
|
+ (beg-B (org-element-property :begin elem-B))
|
|
|
+ (end-A (org-element-property :end elem-A))
|
|
|
+ (end-B (org-element-property :end elem-B)))
|
|
|
+ (or (and (>= beg-A beg-B) (<= end-A end-B))
|
|
|
+ (and (>= beg-B beg-A) (<= end-B end-A)))))
|
|
|
|
|
|
-(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').")
|
|
|
+(defun org-element-swap-A-B (elem-A elem-B)
|
|
|
+ "Swap elements ELEM-A and ELEM-B.
|
|
|
+Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
|
|
|
+end of ELEM-A."
|
|
|
+ (goto-char (org-element-property :begin elem-A))
|
|
|
+ ;; There are two special cases when an element doesn't start at bol:
|
|
|
+ ;; the first paragraph in an item or in a footnote definition.
|
|
|
+ (let ((specialp (not (bolp))))
|
|
|
+ ;; Only a paragraph without any affiliated keyword can be moved at
|
|
|
+ ;; ELEM-A position in such a situation. Note that the case of
|
|
|
+ ;; a footnote definition is impossible: it cannot contain two
|
|
|
+ ;; paragraphs in a row because it cannot contain a blank line.
|
|
|
+ (if (and specialp
|
|
|
+ (or (not (eq (org-element-type elem-B) 'paragraph))
|
|
|
+ (/= (org-element-property :begin elem-B)
|
|
|
+ (org-element-property :contents-begin elem-B))))
|
|
|
+ (error "Cannot swap elements"))
|
|
|
+ ;; In a special situation, ELEM-A will have no indentation. We'll
|
|
|
+ ;; give it ELEM-B's (which will in, in turn, have no indentation).
|
|
|
+ (let* ((ind-B (when specialp
|
|
|
+ (goto-char (org-element-property :begin elem-B))
|
|
|
+ (org-get-indentation)))
|
|
|
+ (beg-A (org-element-property :begin elem-A))
|
|
|
+ (end-A (save-excursion
|
|
|
+ (goto-char (org-element-property :end elem-A))
|
|
|
+ (skip-chars-backward " \r\t\n")
|
|
|
+ (point-at-eol)))
|
|
|
+ (beg-B (org-element-property :begin elem-B))
|
|
|
+ (end-B (save-excursion
|
|
|
+ (goto-char (org-element-property :end elem-B))
|
|
|
+ (skip-chars-backward " \r\t\n")
|
|
|
+ (point-at-eol)))
|
|
|
+ ;; Store overlays responsible for visibility status. We
|
|
|
+ ;; also need to store their boundaries as they will be
|
|
|
+ ;; removed from buffer.
|
|
|
+ (overlays
|
|
|
+ (cons
|
|
|
+ (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
|
|
|
+ (overlays-in beg-A end-A))
|
|
|
+ (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
|
|
|
+ (overlays-in beg-B end-B))))
|
|
|
+ ;; Get contents.
|
|
|
+ (body-A (buffer-substring beg-A end-A))
|
|
|
+ (body-B (delete-and-extract-region beg-B end-B)))
|
|
|
+ (goto-char beg-B)
|
|
|
+ (when specialp
|
|
|
+ (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
|
|
|
+ (org-indent-to-column ind-B))
|
|
|
+ (insert body-A)
|
|
|
+ ;; Restore ex ELEM-A overlays.
|
|
|
+ (let ((offset (- beg-B beg-A)))
|
|
|
+ (mapc (lambda (ov)
|
|
|
+ (move-overlay
|
|
|
+ (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset)))
|
|
|
+ (car overlays))
|
|
|
+ (goto-char beg-A)
|
|
|
+ (delete-region beg-A end-A)
|
|
|
+ (insert body-B)
|
|
|
+ ;; Restore ex ELEM-B overlays.
|
|
|
+ (mapc (lambda (ov)
|
|
|
+ (move-overlay
|
|
|
+ (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset)))
|
|
|
+ (cdr overlays)))
|
|
|
+ (goto-char (org-element-property :end elem-B)))))
|
|
|
|
|
|
-(defvar org-element--cache-merge-changes-threshold 200
|
|
|
- "Number of characters triggering cache syncing.
|
|
|
+(defun org-element-remove-indentation (s &optional n)
|
|
|
+ "Remove maximum common indentation in string S and return it.
|
|
|
+When optional argument N is a positive integer, remove exactly
|
|
|
+that much characters from indentation, if possible, or return
|
|
|
+S as-is otherwise. Unlike to `org-remove-indentation', this
|
|
|
+function doesn't call `untabify' on S."
|
|
|
+ (catch 'exit
|
|
|
+ (with-temp-buffer
|
|
|
+ (insert s)
|
|
|
+ (goto-char (point-min))
|
|
|
+ ;; Find maximum common indentation, if not specified.
|
|
|
+ (setq n (or n
|
|
|
+ (let ((min-ind (point-max)))
|
|
|
+ (save-excursion
|
|
|
+ (while (re-search-forward "^[ \t]*\\S-" nil t)
|
|
|
+ (let ((ind (1- (current-column))))
|
|
|
+ (if (zerop ind) (throw 'exit s)
|
|
|
+ (setq min-ind (min min-ind ind))))))
|
|
|
+ min-ind)))
|
|
|
+ (if (zerop n) s
|
|
|
+ ;; Remove exactly N indentation, but give up if not possible.
|
|
|
+ (while (not (eobp))
|
|
|
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
|
|
|
+ (cond ((eolp) (delete-region (line-beginning-position) (point)))
|
|
|
+ ((< ind n) (throw 'exit s))
|
|
|
+ (t (org-indent-line-to (- ind n))))
|
|
|
+ (forward-line)))
|
|
|
+ (buffer-string)))))
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+;;; Cache
|
|
|
+;;
|
|
|
+;; Both functions `org-element-at-point' and `org-element-context'
|
|
|
+;; benefit from a simple caching mechanism.
|
|
|
+;;
|
|
|
+;; Three public functions are provided: `org-element-cache-put',
|
|
|
+;; `org-element-cache-get' and `org-element-cache-reset'.
|
|
|
+;;
|
|
|
+;; Cache is enabled by default, but can be disabled globally with
|
|
|
+;; `org-element-use-cache'. `org-element-cache-sync-idle-time' and
|
|
|
+;; `org-element-cache-merge-changes-threshold' can be tweaked to
|
|
|
+;; control caching behaviour.
|
|
|
+
|
|
|
+
|
|
|
+(defvar org-element-use-cache t
|
|
|
+ "Non nil when Org parser should cache its results.
|
|
|
+This is mostly for debugging purpose.")
|
|
|
+
|
|
|
+(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
|
|
@@ -4778,6 +5164,65 @@ 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-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').")
|
|
|
+
|
|
|
+
|
|
|
+;;;; Data Structure
|
|
|
+
|
|
|
+(defvar org-element--cache nil
|
|
|
+ "AVL tree used to cache elements.
|
|
|
+Each node of the tree contains an element. Comparison is done
|
|
|
+with `org-element--cache-compare'. This cache is used in
|
|
|
+`org-element-at-point'.")
|
|
|
+
|
|
|
+(defvar org-element--cache-objects nil
|
|
|
+ "Hash table used as to cache objects.
|
|
|
+Key is an element, as returned by `org-element-at-point', and
|
|
|
+value 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 `org-element-context'.")
|
|
|
+
|
|
|
+(defun org-element--cache-compare (a b)
|
|
|
+ "Non-nil when element A is located before element B."
|
|
|
+ (let ((beg-a (org-element-property :begin a))
|
|
|
+ (beg-b (org-element-property :begin b)))
|
|
|
+ (or (< beg-a beg-b)
|
|
|
+ ;; Items and plain lists on the one hand, table rows and
|
|
|
+ ;; tables on the other hand can start at the same position.
|
|
|
+ ;; In this case, the parent element is always before its child
|
|
|
+ ;; in the buffer.
|
|
|
+ (and (= beg-a beg-b)
|
|
|
+ (memq (org-element-type a) '(plain-list table))
|
|
|
+ (memq (org-element-type b) '(item table-row))))))
|
|
|
+
|
|
|
+
|
|
|
+;;;; Staging Buffer Changes
|
|
|
+
|
|
|
(defvar org-element--cache-status nil
|
|
|
"Contains data about cache validity for current buffer.
|
|
|
|
|
@@ -4802,26 +5247,27 @@ 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))))))
|
|
|
+(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.")
|
|
|
|
|
|
(defsubst org-element--cache-pending-changes-p ()
|
|
|
"Non-nil when changes are not integrated in cache yet."
|
|
@@ -4839,7 +5285,7 @@ integer."
|
|
|
(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
|
|
|
+ (run-with-idle-timer org-element-cache-sync-idle-time
|
|
|
nil
|
|
|
#'org-element--cache-sync
|
|
|
(current-buffer)))))
|
|
@@ -4851,92 +5297,6 @@ integer."
|
|
|
(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--cache-shift-positions (element offset &optional props)
|
|
|
- "Shift ELEMENT properties relative to buffer positions by OFFSET.
|
|
|
-
|
|
|
-Properties containing buffer positions are `:begin', `:end',
|
|
|
-`:contents-begin', `:contents-end' and `:structure'. When
|
|
|
-optional argument PROPS is a list of keywords, only shift
|
|
|
-properties provided in that list.
|
|
|
-
|
|
|
-Properties are modified by side-effect. Return 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 (and (or (not props) (memq :structure props))
|
|
|
- (eq (org-element-type element) 'plain-list)
|
|
|
- (not (eq (org-element-type (plist-get properties :parent))
|
|
|
- 'item)))
|
|
|
- (dolist (item (plist-get properties :structure))
|
|
|
- (incf (car item) offset)
|
|
|
- (incf (nth 6 item) offset)))
|
|
|
- (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated))
|
|
|
- (let ((value (and (or (not props) (memq key props))
|
|
|
- (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
|
|
@@ -5026,7 +5386,7 @@ new one."
|
|
|
(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 (> 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
|
|
@@ -5044,12 +5404,34 @@ new one."
|
|
|
(- (max current-end bottom) offset))
|
|
|
(incf (aref org-element--cache-status 3) offset))))))))))
|
|
|
|
|
|
-(defconst org-element--cache-stable-types
|
|
|
- '(center-block drawer dynamic-block headline inlinetask property-drawer
|
|
|
- quote-block special-block)
|
|
|
- "List of stable greater elements types.
|
|
|
-Stable elements are elements that don't need to be removed from
|
|
|
-cache when their contents only are modified.")
|
|
|
+
|
|
|
+;;;; Synchronization
|
|
|
+
|
|
|
+(defsubst org-element--cache-shift-positions (element offset &optional props)
|
|
|
+ "Shift ELEMENT properties relative to buffer positions by OFFSET.
|
|
|
+
|
|
|
+Properties containing buffer positions are `:begin', `:end',
|
|
|
+`:contents-begin', `:contents-end' and `:structure'. When
|
|
|
+optional argument PROPS is a list of keywords, only shift
|
|
|
+properties provided in that list.
|
|
|
+
|
|
|
+Properties are modified by side-effect. Return 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 (and (or (not props) (memq :structure props))
|
|
|
+ (eq (org-element-type element) 'plain-list)
|
|
|
+ (not (eq (org-element-type (plist-get properties :parent))
|
|
|
+ 'item)))
|
|
|
+ (dolist (item (plist-get properties :structure))
|
|
|
+ (incf (car item) offset)
|
|
|
+ (incf (nth 6 item) offset)))
|
|
|
+ (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated))
|
|
|
+ (let ((value (and (or (not props) (memq key props))
|
|
|
+ (plist-get properties key))))
|
|
|
+ (and value (plist-put properties key (+ offset value))))))
|
|
|
+ element)
|
|
|
|
|
|
(defun org-element--cache-sync (buffer)
|
|
|
"Synchronize cache with recent modification in BUFFER.
|
|
@@ -5060,571 +5442,207 @@ 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.
|
|
|
- (let* ((conflictp (consp (caar value)))
|
|
|
- (value-to-shift (if conflictp (cdr value) value)))
|
|
|
- (cond
|
|
|
- ;; If an element is missing one of its parents,
|
|
|
- ;; remove it from cache. In a middle of
|
|
|
- ;; a conflict take care not to remove already
|
|
|
- ;; shifted element.
|
|
|
- ((catch 'remove
|
|
|
- (let ((parent (car value-to-shift)))
|
|
|
- (while (setq parent
|
|
|
- (org-element-property :parent parent))
|
|
|
+ (catch 'escape
|
|
|
+ (let ((inhibit-quit t)
|
|
|
+ (offset (aref org-element--cache-status 3))
|
|
|
+ ;; END is the beginning position of the first element
|
|
|
+ ;; in cache that isn't removed but needs to be
|
|
|
+ ;; shifted. It will be updated during phase 1.
|
|
|
+ (end (aref org-element--cache-status 2)))
|
|
|
+ ;; Phase 1.
|
|
|
+ ;;
|
|
|
+ ;; Delete, in ascending order, all elements starting after
|
|
|
+ ;; BEG, but before END.
|
|
|
+ ;;
|
|
|
+ ;; BEG is the position of the first element in cache to
|
|
|
+ ;; remove. It takes into consideration partially modified
|
|
|
+ ;; elements (starting before changes but ending after
|
|
|
+ ;; them). Though, it preserves greater elements that are
|
|
|
+ ;; not affected when changes alter only their contents.
|
|
|
+ ;;
|
|
|
+ ;; END is updated when necessary to include elements
|
|
|
+ ;; starting after modifications but included in an element
|
|
|
+ ;; altered by modifications.
|
|
|
+ ;;
|
|
|
+ ;; At each iteration, we start again at tree root since
|
|
|
+ ;; a deletion modifies structure of the balanced tree.
|
|
|
+ (let ((beg
|
|
|
+ (let* ((beg (aref org-element--cache-status 1))
|
|
|
+ (element (org-element-cache-get (1- beg) t)))
|
|
|
+ (if (not element) beg
|
|
|
+ (catch 'exit
|
|
|
+ (let ((up element))
|
|
|
+ (while (setq up (org-element-property :parent up))
|
|
|
+ (if (and
|
|
|
+ (memq (org-element-type up)
|
|
|
+ '(center-block
|
|
|
+ drawer dynamic-block inlinetask
|
|
|
+ property-drawer quote-block
|
|
|
+ special-block))
|
|
|
+ (<= (org-element-property :contents-begin up)
|
|
|
+ beg)
|
|
|
+ (> (org-element-property :contents-end up)
|
|
|
+ end))
|
|
|
+ ;; UP is a greater element that is
|
|
|
+ ;; wrapped around the changes. We
|
|
|
+ ;; only need to extend its ending
|
|
|
+ ;; boundaries and those of all its
|
|
|
+ ;; parents.
|
|
|
+ (throw 'exit
|
|
|
+ (progn
|
|
|
+ (while up
|
|
|
+ (org-element--cache-shift-positions
|
|
|
+ up offset '(:contents-end :end))
|
|
|
+ (setq up (org-element-property
|
|
|
+ :parent up)))
|
|
|
+ (org-element-property
|
|
|
+ :begin element))))
|
|
|
+ (setq element up))
|
|
|
+ ;; We're at top level element containing
|
|
|
+ ;; ELEMENT: if it's altered by buffer
|
|
|
+ ;; modifications, it is first element in
|
|
|
+ ;; cache to be removed. Otherwise, that
|
|
|
+ ;; first element is the following one.
|
|
|
+ (if (< (org-element-property :end element) beg)
|
|
|
+ (org-element-property :end element)
|
|
|
+ (org-element-property :begin element))))))))
|
|
|
+ (while (let ((node (avl-tree--root org-element--cache)) data)
|
|
|
+ ;; DATA will contain the closest element from
|
|
|
+ ;; BEG, always after it.
|
|
|
+ (while node
|
|
|
+ (let* ((element (avl-tree--node-data node))
|
|
|
+ (pos (org-element-property :begin element)))
|
|
|
(cond
|
|
|
- ((<= (org-element-property :contents-begin parent)
|
|
|
- beg)
|
|
|
- (unless (memq (org-element-type parent)
|
|
|
- org-element--cache-stable-types)
|
|
|
- (throw 'remove t)))
|
|
|
- ((<= (org-element-property :begin parent) end)
|
|
|
- (throw 'remove t))))
|
|
|
- ;; No missing parent: proceed with shifting.
|
|
|
- nil))
|
|
|
- (if conflictp (puthash key (car value) org-element--cache)
|
|
|
- (remhash key org-element--cache)))
|
|
|
- ;; No offset: no need to shift.
|
|
|
- ((zerop offset))
|
|
|
- (t
|
|
|
- (let* ((conflictp (consp (caar value)))
|
|
|
- (value-to-shift (if conflictp (cdr value) value)))
|
|
|
- ;; Shift element part.
|
|
|
- (org-element--cache-shift-positions
|
|
|
- (car value-to-shift) offset)
|
|
|
- ;; Shift objects part.
|
|
|
- (dolist (object-data (cdr value-to-shift))
|
|
|
+ ((< pos beg)
|
|
|
+ (setq node (avl-tree--node-right node)))
|
|
|
+ ((> pos beg)
|
|
|
+ (setq data (avl-tree--node-data node)
|
|
|
+ node (avl-tree--node-left node)))
|
|
|
+ (t
|
|
|
+ (setq data (avl-tree--node-data node)
|
|
|
+ node nil)))))
|
|
|
+ (cond
|
|
|
+ ;; No DATA is found so there's no element left
|
|
|
+ ;; after BEG. Bail out.
|
|
|
+ ((not data) (throw 'escape t))
|
|
|
+ ;; Element starts after END, it is the first
|
|
|
+ ;; one that needn't be removed from cache.
|
|
|
+ ;; Move to second phase.
|
|
|
+ ((> (org-element-property :begin data) end) nil)
|
|
|
+ ;; Remove element. Extend END so that all
|
|
|
+ ;; elements it may contain are also removed.
|
|
|
+ (t
|
|
|
+ (setq end
|
|
|
+ (max (1- (org-element-property :end data)) end))
|
|
|
+ (avl-tree-delete org-element--cache data nil t))))))
|
|
|
+ ;; Phase 2.
|
|
|
+ ;;
|
|
|
+ ;; Shift all elements starting after END by OFFSET (for an
|
|
|
+ ;; offset different from 0).
|
|
|
+ ;;
|
|
|
+ ;; Increasing all beginning positions by OFFSET doesn't
|
|
|
+ ;; alter tree structure, so elements are modified by
|
|
|
+ ;; side-effect.
|
|
|
+ ;;
|
|
|
+ ;; We change all elements in decreasing order and make
|
|
|
+ ;; sure to quit at the first element in cache starting
|
|
|
+ ;; before END.
|
|
|
+ (unless (zerop offset)
|
|
|
+ (catch 'exit
|
|
|
+ (avl-tree-mapc
|
|
|
+ #'(lambda (data)
|
|
|
+ (if (<= (org-element-property :begin data) end)
|
|
|
+ (throw 'exit t)
|
|
|
+ ;; Shift element.
|
|
|
+ (org-element--cache-shift-positions data offset)
|
|
|
+ ;; Shift associated objects data, if any.
|
|
|
+ (dolist (object-data
|
|
|
+ (gethash data org-element--cache-objects))
|
|
|
(incf (car object-data) offset)
|
|
|
(dolist (successor (nth 1 object-data))
|
|
|
(incf (cdr successor) offset))
|
|
|
(dolist (object (cddr object-data))
|
|
|
- (org-element--cache-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))
|
|
|
- ;; From now on, element starts before changes.
|
|
|
- (t
|
|
|
- (let ((element (car value)))
|
|
|
- (cond
|
|
|
- ;; Element ended before actual buffer
|
|
|
- ;; modifications. Remove it only if any of its
|
|
|
- ;; parents is or will be removed from cache.
|
|
|
- ((< (org-element-property :end element) beg)
|
|
|
- (catch 'remove
|
|
|
- (let ((parent element))
|
|
|
- (while (setq parent
|
|
|
- (org-element-property :parent parent))
|
|
|
- (cond
|
|
|
- ((> (org-element-property :contents-end parent) end)
|
|
|
- (unless (memq (org-element-type parent)
|
|
|
- org-element--cache-stable-types)
|
|
|
- (throw 'remove
|
|
|
- (remhash key org-element--cache))))
|
|
|
- ((>= (org-element-property :end parent) beg)
|
|
|
- (throw 'remove
|
|
|
- (remhash key org-element--cache))))))))
|
|
|
- ;; Preserve stable greater elements (or verse
|
|
|
- ;; blocks) when changes are limited to their
|
|
|
- ;; contents only. In that case, extend both their
|
|
|
- ;; contents ending position and their ending
|
|
|
- ;; position by OFFSET.
|
|
|
- ((let ((contents-end
|
|
|
- (org-element-property :contents-end element))
|
|
|
- (type (org-element-type element)))
|
|
|
- (and contents-end
|
|
|
- (> contents-end end)
|
|
|
- (or (memq type org-element--cache-stable-types)
|
|
|
- (eq type 'verse-block))))
|
|
|
- (org-element--cache-shift-positions
|
|
|
- element offset '(:contents-end :end)))
|
|
|
- ;; Element ended within modified area: remove it.
|
|
|
- (t (remhash key org-element--cache)))))))
|
|
|
- org-element--cache)
|
|
|
- ;; Signal cache as up-to-date.
|
|
|
- (org-element--cache-cancel-changes))))))
|
|
|
+ (org-element--cache-shift-positions
|
|
|
+ object offset)))))
|
|
|
+ org-element--cache 'reverse)))))
|
|
|
+ ;; Eventually signal cache as up-to-date.
|
|
|
+ (org-element--cache-cancel-changes)))))
|
|
|
|
|
|
-;;;###autoload
|
|
|
-(defun org-element-at-point ()
|
|
|
- "Determine closest element around point.
|
|
|
|
|
|
-Return value is a list like (TYPE PROPS) where TYPE is the type
|
|
|
-of the element and PROPS a plist of properties associated to the
|
|
|
-element.
|
|
|
+;;;; Public Functions
|
|
|
|
|
|
-Possible types are defined in `org-element-all-elements'.
|
|
|
-Properties depend on element or object type, but always include
|
|
|
-`:begin', `:end', `:parent' and `:post-blank' properties.
|
|
|
+(defun org-element-cache-get (key &optional ignore-changes)
|
|
|
+ "Return cached data relative to KEY.
|
|
|
|
|
|
-As a special case, if point is at the very beginning of a list or
|
|
|
-sub-list, returned element will be that list instead of the first
|
|
|
-item. In the same way, if point is at the beginning of the first
|
|
|
-row of a table, returned element will be the table instead of the
|
|
|
-first row."
|
|
|
- (org-with-wide-buffer
|
|
|
- (let ((origin (point)) element parent end)
|
|
|
- (end-of-line)
|
|
|
- (skip-chars-backward " \r\t\n")
|
|
|
- (cond
|
|
|
- ((bobp) nil)
|
|
|
- ((org-with-limited-levels (org-at-heading-p))
|
|
|
- (beginning-of-line)
|
|
|
- (or (org-element-cache-get (point) 'element)
|
|
|
- (car (org-element-cache-put
|
|
|
- (point)
|
|
|
- (list (org-element-headline-parser (point-max) t))))))
|
|
|
- (t
|
|
|
- (catch 'loop
|
|
|
- (when org-element-use-cache
|
|
|
- ;; Opportunistic shortcut. Instead of going back to
|
|
|
- ;; headline above (or beginning of buffer) and descending
|
|
|
- ;; again, first try to find a known element above current
|
|
|
- ;; position. Give up after 10 tries or when we hit
|
|
|
- ;; a headline (or beginning of buffer).
|
|
|
- (beginning-of-line)
|
|
|
- (dotimes (i 10)
|
|
|
- (skip-chars-backward " \r\t\n")
|
|
|
- (cond ((not (re-search-backward "^\\(?:\\*+ \\|[ \t]*$\\)" nil t))
|
|
|
- (throw 'loop (goto-char (point-min))))
|
|
|
- ((/= (char-after) ?*)
|
|
|
- (when (bobp) (throw 'loop nil))
|
|
|
- ;; An element cannot start at a blank line, so
|
|
|
- ;; check line below.
|
|
|
- (forward-line))
|
|
|
- ((org-with-limited-levels (org-at-heading-p))
|
|
|
- ;; Tough luck: we're back at a headline above.
|
|
|
- ;; Move to beginning of section.
|
|
|
- (forward-line)
|
|
|
- (skip-chars-forward " \r\t\n")
|
|
|
- (beginning-of-line)
|
|
|
- (throw 'loop nil)))
|
|
|
- (let ((cached (org-element-cache-get (point) 'element)))
|
|
|
- (when cached
|
|
|
- ;; Search successful: we know an element before point
|
|
|
- ;; which is not an headline. If it has a common
|
|
|
- ;; ancestor with ORIGIN, set this ancestor as the
|
|
|
- ;; current parent and the element as the one to
|
|
|
- ;; check. Otherwise, move at top level and start
|
|
|
- ;; parsing right after its broader ancestor.
|
|
|
- (let ((cache-end (org-element-property :end cached)))
|
|
|
- (if (> cache-end origin)
|
|
|
- (setq element cached
|
|
|
- parent (org-element-property :parent cached)
|
|
|
- end cache-end)
|
|
|
- (goto-char cache-end)
|
|
|
- (let ((up cached) (last cached))
|
|
|
- (while (and (setq up (org-element-property :parent up))
|
|
|
- (<= (org-element-property :end up) origin))
|
|
|
- (goto-char (org-element-property :end up))
|
|
|
- (setq last up))
|
|
|
- (setq element (or up last)
|
|
|
- parent (org-element-property :parent up)
|
|
|
- end (org-element-property :end up)))))
|
|
|
- (throw 'loop nil)))))
|
|
|
- ;; Opportunistic search failed. Move back to beginning of
|
|
|
- ;; section in current headline, if any, or to first non-empty
|
|
|
- ;; line in buffer otherwise.
|
|
|
- (org-with-limited-levels (outline-previous-heading))
|
|
|
- (when (org-at-heading-p) (forward-line))
|
|
|
- (skip-chars-forward " \r\t\n")
|
|
|
- (beginning-of-line))
|
|
|
- ;; Now we are at the beginning of an element, start parsing.
|
|
|
- (unless end
|
|
|
- (save-excursion (org-with-limited-levels (outline-next-heading))
|
|
|
- (setq end (point))))
|
|
|
- (let (type special-flag struct)
|
|
|
- ;; Parse successively each element, skipping those ending
|
|
|
- ;; before original position.
|
|
|
- (catch 'exit
|
|
|
- (while t
|
|
|
- (unless element
|
|
|
- (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))))
|
|
|
- (or (org-element-cache-get pos 'element)
|
|
|
- (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)))
|
|
|
- (org-element-put-property element
|
|
|
- :parent parent))))))
|
|
|
- (setq type (org-element-type element))
|
|
|
- (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)))
|
|
|
- (setq element nil))
|
|
|
- ;; 2. An element containing point is always the element
|
|
|
- ;; at point.
|
|
|
- ((not (memq type org-element-greater-elements))
|
|
|
- (throw 'exit 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 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 parent element element nil end cend)
|
|
|
- (goto-char cbeg)))))))))))))
|
|
|
-
|
|
|
-;;;###autoload
|
|
|
-(defun org-element-context (&optional element)
|
|
|
- "Return closest element or object around point.
|
|
|
-
|
|
|
-Return value is a list like (TYPE PROPS) where TYPE is the type
|
|
|
-of the element or object and PROPS a plist of properties
|
|
|
-associated to it.
|
|
|
-
|
|
|
-Possible types are defined in `org-element-all-elements' and
|
|
|
-`org-element-all-objects'. Properties depend on element or
|
|
|
-object type, but always include `:begin', `:end', `:parent' and
|
|
|
-`:post-blank'.
|
|
|
+KEY is either a number or an Org element, as returned by
|
|
|
+`org-element-at-point'. If KEY is a number, return closest
|
|
|
+cached data before or at position KEY. Otherwise, return cached
|
|
|
+objects contained in element KEY.
|
|
|
|
|
|
-Optional argument ELEMENT, when non-nil, is the closest element
|
|
|
-containing point, as returned by `org-element-at-point'.
|
|
|
-Providing it allows for quicker computation."
|
|
|
- (catch 'objects-forbidden
|
|
|
- (org-with-wide-buffer
|
|
|
- (let* ((origin (point))
|
|
|
- (element (or element (org-element-at-point)))
|
|
|
- (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.
|
|
|
- ((let ((post (org-element-property :post-affiliated element)))
|
|
|
- (and post (< origin post)))
|
|
|
- (beginning-of-line)
|
|
|
- (let ((case-fold-search t)) (looking-at org-element--affiliated-re))
|
|
|
- (cond
|
|
|
- ((not (member-ignore-case (match-string 1)
|
|
|
- org-element-parsed-keywords))
|
|
|
- (throw 'objects-forbidden element))
|
|
|
- ((< (match-end 0) origin)
|
|
|
- (narrow-to-region (match-end 0) (line-end-position)))
|
|
|
- ((and (match-beginning 2)
|
|
|
- (>= origin (match-beginning 2))
|
|
|
- (< origin (match-end 2)))
|
|
|
- (narrow-to-region (match-beginning 2) (match-end 2)))
|
|
|
- (t (throw 'objects-forbidden element)))
|
|
|
- ;; Also change type to retrieve correct restrictions.
|
|
|
- (setq type 'keyword))
|
|
|
- ;; At an item, objects can only be located within tag, if any.
|
|
|
- ((eq type 'item)
|
|
|
- (let ((tag (org-element-property :tag element)))
|
|
|
- (if (not tag) (throw 'objects-forbidden element)
|
|
|
- (beginning-of-line)
|
|
|
- (search-forward tag (line-end-position))
|
|
|
- (goto-char (match-beginning 0))
|
|
|
- (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 in title.
|
|
|
- ((memq type '(headline inlinetask))
|
|
|
- (goto-char (org-element-property :begin element))
|
|
|
- (skip-chars-forward "* ")
|
|
|
- (if (and (>= origin (point)) (< origin (line-end-position)))
|
|
|
- (narrow-to-region (point) (line-end-position))
|
|
|
- (throw 'objects-forbidden element)))
|
|
|
- ;; At a paragraph, a table-row or a verse block, objects are
|
|
|
- ;; located within their contents.
|
|
|
- ((memq type '(paragraph table-row verse-block))
|
|
|
- (let ((cbeg (org-element-property :contents-begin element))
|
|
|
- (cend (org-element-property :contents-end element)))
|
|
|
- ;; CBEG is nil for table rules.
|
|
|
- (if (and cbeg cend (>= origin cbeg) (< origin cend))
|
|
|
- (narrow-to-region cbeg cend)
|
|
|
- (throw 'objects-forbidden element))))
|
|
|
- ;; At a parsed keyword, objects are located within value.
|
|
|
- ((eq type 'keyword)
|
|
|
- (if (not (member (org-element-property :key element)
|
|
|
- org-element-document-properties))
|
|
|
- (throw 'objects-forbidden element)
|
|
|
- (beginning-of-line)
|
|
|
- (search-forward ":")
|
|
|
- (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)
|
|
|
- (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)))))))))
|
|
|
+In any case, return nil if no data is found, or if caching is not
|
|
|
+allowed.
|
|
|
|
|
|
-(defun org-element-nested-p (elem-A elem-B)
|
|
|
- "Non-nil when elements ELEM-A and ELEM-B are nested."
|
|
|
- (let ((beg-A (org-element-property :begin elem-A))
|
|
|
- (beg-B (org-element-property :begin elem-B))
|
|
|
- (end-A (org-element-property :end elem-A))
|
|
|
- (end-B (org-element-property :end elem-B)))
|
|
|
- (or (and (>= beg-A beg-B) (<= end-A end-B))
|
|
|
- (and (>= beg-B beg-A) (<= end-B end-A)))))
|
|
|
+If changes are pending in current buffer, first synchronize the
|
|
|
+cache, unless optional argument IGNORE-CHANGES is non-nil."
|
|
|
+ (when (and org-element-use-cache org-element--cache)
|
|
|
+ ;; If there are pending changes, first sync them.
|
|
|
+ (when (and (not ignore-changes) (org-element--cache-pending-changes-p))
|
|
|
+ (org-element--cache-sync (current-buffer)))
|
|
|
+ (if (not (wholenump key)) (gethash key org-element--cache-objects)
|
|
|
+ (let ((node (avl-tree--root org-element--cache)) last)
|
|
|
+ (catch 'found
|
|
|
+ (while node
|
|
|
+ (let* ((element (avl-tree--node-data node))
|
|
|
+ (beg (org-element-property :begin element)))
|
|
|
+ (cond
|
|
|
+ ((< key beg)
|
|
|
+ (setq node (avl-tree--node-left node)))
|
|
|
+ ((= key beg)
|
|
|
+ (if (memq (org-element-type element) '(item table-row))
|
|
|
+ (setq last (avl-tree--node-data node)
|
|
|
+ node (avl-tree--node-left node))
|
|
|
+ (throw 'found (avl-tree--node-data node))))
|
|
|
+ (t
|
|
|
+ (setq last (avl-tree--node-data node)
|
|
|
+ node (avl-tree--node-right node))))))
|
|
|
+ last)))))
|
|
|
+
|
|
|
+(defun org-element-cache-put (data &optional element)
|
|
|
+ "Store DATA in current buffer's cache, if allowed.
|
|
|
+If optional argument ELEMENT is non-nil, store DATA as objects
|
|
|
+relative to it. Otherwise, store DATA as an element. Nothing
|
|
|
+will be stored if `org-element-use-cache' is nil. Return DATA."
|
|
|
+ (if (not (and org-element-use-cache (derived-mode-p 'org-mode))) data
|
|
|
+ (unless (and org-element--cache org-element--cache-objects)
|
|
|
+ (org-element-cache-reset))
|
|
|
+ (if element (puthash element data org-element--cache-objects)
|
|
|
+ (avl-tree-enter org-element--cache data))))
|
|
|
|
|
|
-(defun org-element-swap-A-B (elem-A elem-B)
|
|
|
- "Swap elements ELEM-A and ELEM-B.
|
|
|
-Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
|
|
|
-end of ELEM-A."
|
|
|
- (goto-char (org-element-property :begin elem-A))
|
|
|
- ;; There are two special cases when an element doesn't start at bol:
|
|
|
- ;; the first paragraph in an item or in a footnote definition.
|
|
|
- (let ((specialp (not (bolp))))
|
|
|
- ;; Only a paragraph without any affiliated keyword can be moved at
|
|
|
- ;; ELEM-A position in such a situation. Note that the case of
|
|
|
- ;; a footnote definition is impossible: it cannot contain two
|
|
|
- ;; paragraphs in a row because it cannot contain a blank line.
|
|
|
- (if (and specialp
|
|
|
- (or (not (eq (org-element-type elem-B) 'paragraph))
|
|
|
- (/= (org-element-property :begin elem-B)
|
|
|
- (org-element-property :contents-begin elem-B))))
|
|
|
- (error "Cannot swap elements"))
|
|
|
- ;; In a special situation, ELEM-A will have no indentation. We'll
|
|
|
- ;; give it ELEM-B's (which will in, in turn, have no indentation).
|
|
|
- (let* ((ind-B (when specialp
|
|
|
- (goto-char (org-element-property :begin elem-B))
|
|
|
- (org-get-indentation)))
|
|
|
- (beg-A (org-element-property :begin elem-A))
|
|
|
- (end-A (save-excursion
|
|
|
- (goto-char (org-element-property :end elem-A))
|
|
|
- (skip-chars-backward " \r\t\n")
|
|
|
- (point-at-eol)))
|
|
|
- (beg-B (org-element-property :begin elem-B))
|
|
|
- (end-B (save-excursion
|
|
|
- (goto-char (org-element-property :end elem-B))
|
|
|
- (skip-chars-backward " \r\t\n")
|
|
|
- (point-at-eol)))
|
|
|
- ;; Store overlays responsible for visibility status. We
|
|
|
- ;; also need to store their boundaries as they will be
|
|
|
- ;; removed from buffer.
|
|
|
- (overlays
|
|
|
- (cons
|
|
|
- (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
|
|
|
- (overlays-in beg-A end-A))
|
|
|
- (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
|
|
|
- (overlays-in beg-B end-B))))
|
|
|
- ;; Get contents.
|
|
|
- (body-A (buffer-substring beg-A end-A))
|
|
|
- (body-B (delete-and-extract-region beg-B end-B)))
|
|
|
- (goto-char beg-B)
|
|
|
- (when specialp
|
|
|
- (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
|
|
|
- (org-indent-to-column ind-B))
|
|
|
- (insert body-A)
|
|
|
- ;; Restore ex ELEM-A overlays.
|
|
|
- (let ((offset (- beg-B beg-A)))
|
|
|
- (mapc (lambda (ov)
|
|
|
- (move-overlay
|
|
|
- (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset)))
|
|
|
- (car overlays))
|
|
|
- (goto-char beg-A)
|
|
|
- (delete-region beg-A end-A)
|
|
|
- (insert body-B)
|
|
|
- ;; Restore ex ELEM-B overlays.
|
|
|
- (mapc (lambda (ov)
|
|
|
- (move-overlay
|
|
|
- (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset)))
|
|
|
- (cdr overlays)))
|
|
|
- (goto-char (org-element-property :end elem-B)))))
|
|
|
+;;;###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)
|
|
|
+ (avl-tree-clear org-element--cache)
|
|
|
+ (org-set-local 'org-element--cache
|
|
|
+ (avl-tree-create #'org-element--cache-compare)))
|
|
|
+ (if org-element--cache-objects (clrhash org-element--cache-objects)
|
|
|
+ (org-set-local
|
|
|
+ 'org-element--cache-objects
|
|
|
+ (make-hash-table :size 1009 :weakness 'key :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))))))
|
|
|
|
|
|
-(defun org-element-remove-indentation (s &optional n)
|
|
|
- "Remove maximum common indentation in string S and return it.
|
|
|
-When optional argument N is a positive integer, remove exactly
|
|
|
-that much characters from indentation, if possible, or return
|
|
|
-S as-is otherwise. Unlike to `org-remove-indentation', this
|
|
|
-function doesn't call `untabify' on S."
|
|
|
- (catch 'exit
|
|
|
- (with-temp-buffer
|
|
|
- (insert s)
|
|
|
- (goto-char (point-min))
|
|
|
- ;; Find maximum common indentation, if not specified.
|
|
|
- (setq n (or n
|
|
|
- (let ((min-ind (point-max)))
|
|
|
- (save-excursion
|
|
|
- (while (re-search-forward "^[ \t]*\\S-" nil t)
|
|
|
- (let ((ind (1- (current-column))))
|
|
|
- (if (zerop ind) (throw 'exit s)
|
|
|
- (setq min-ind (min min-ind ind))))))
|
|
|
- min-ind)))
|
|
|
- (if (zerop n) s
|
|
|
- ;; Remove exactly N indentation, but give up if not possible.
|
|
|
- (while (not (eobp))
|
|
|
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
|
|
|
- (cond ((eolp) (delete-region (line-beginning-position) (point)))
|
|
|
- ((< ind n) (throw 'exit s))
|
|
|
- (t (org-indent-line-to (- ind n))))
|
|
|
- (forward-line)))
|
|
|
- (buffer-string)))))
|
|
|
|
|
|
|
|
|
(provide 'org-element)
|