From e32ebb6c1ad1455cc34d29cc0881cff84ebde12f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 5 Jan 2014 00:37:37 +0100 Subject: [PATCH] org-element: Change data structure for cache * lisp/org-element.el (org-element-at-point, org-element-cache-get, org-element-cache-put, org-element--cache-sync): Complete rewrite to use new data structure. (org-element-context, org-element-cache-reset): Slight change in order to use new tools to access cached data. (org-element-cache-merge-changes-threshold): Renamed from `org-element--cache-merge-changes-threshold'. (org-element-cache-sync-idle-time): Renamed from `org-element--cache-sync-idle-time'. (org-element--cache-objects): New variable. Now elements are stored in AVL tree and objects in a hash table. Also moved functions relative to cache into a specific section of the file. --- lisp/org-element.el | 1440 ++++++++++++++++++++++++++------------------------- 1 file changed, 729 insertions(+), 711 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 6c2d5e11f..b8e808298 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -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) -- 2.11.4.GIT