>From 6fa0c2908c9cc3c768ec484ce9d7f87a971a4fa5 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <address@hidden>
Date: Thu, 3 Oct 2013 22:12:35 +0200
Subject: [PATCH] org-element: Implement caching for dynamic parser

* lisp/org-element.el (org-element-use-cache, org-element--cache,
org-element--cache-sync-idle-time,
org-element--cache-merge-changes-threshold, org-element--cache-status,
org-element--cache-opening-line, org-element--cache-closing-line): New
variables.
(org-element-cache-reset, org-element--cache-pending-changes-p,
org-element--cache-push-change, org-element--cache-cancel-changes,
org-element--cache-get-key, org-element-cache-get,
org-element-cache-put, org-element--shift-positions,
org-element--cache-before-change, org-element--cache-record-change,
org-element--cache-sync): New functions.
(org-element-at-point, org-element-context): Use cache when possible.
* lisp/org.el (org-mode, org-set-modules): Reset cache.
* lisp/org-footnote.el (org-footnote-section): Reset cache.
* lisp/org-src.el (org-src-preserve-indentation): Reset cache.
* testing/lisp/test-org-element.el: Update tests.

This patch gives a boost to `org-element-at-point' and, to a lesser
extent, to `org-element-context'.
---
 lisp/org-element.el              | 750 ++++++++++++++++++++++++++++++++-------
 lisp/org-footnote.el             |   9 +-
 lisp/org-src.el                  |  25 +-
 lisp/org.el                      |   6 +-
 testing/lisp/test-org-element.el |  18 +-
 5 files changed, 658 insertions(+), 150 deletions(-)

diff --git a/lisp/org-element.el b/lisp/org-element.el
index 329d00a..cbe0e56 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -111,7 +111,8 @@
 ;;
 ;; The library ends by furnishing `org-element-at-point' function, and
 ;; a way to give information about document structure around point
-;; with `org-element-context'.
+;; with `org-element-context'.  A simple cache mechanism is also
+;; provided for these functions.
 
 
 ;;; Code:
@@ -4646,7 +4647,7 @@ indentation is not done with TAB characters."
 ;; The first move is to implement a way to obtain the smallest element
 ;; containing point.  This is the job of `org-element-at-point'.  It
 ;; basically jumps back to the beginning of section containing point
-;; and moves, element after element, with
+;; and proceed, one element after the other, with
 ;; `org-element--current-element' until the container is found.  Note:
 ;; When using `org-element-at-point', secondary values are never
 ;; parsed since the function focuses on elements, not on objects.
@@ -4654,8 +4655,417 @@ indentation is not done with TAB characters."
 ;; At a deeper level, `org-element-context' lists all elements and
 ;; objects containing point.
 ;;
-;; `org-element-nested-p' and `org-element-swap-A-B' may be used
-;; internally by navigation and manipulation tools.
+;; Both functions benefit from a simple caching mechanism.  It is
+;; enabled by default, but can be disabled globally with
+;; `org-element-use-cache'.  Also `org-element-cache-reset' clears or
+;; initializes cache for current buffer.  Values are retrieved and put
+;; into cache with respectively, `org-element-cache-get' and
+;; `org-element-cache-put'.  `org-element--cache-sync-idle-time' and
+;; `org-element--cache-merge-changes-threshold' are used internally to
+;; control caching behaviour.
+;;
+;; Eventually `org-element-nested-p' and `org-element-swap-A-B' may be
+;; used internally by navigation and manipulation tools.
+
+(defvar org-element-use-cache t
+  "Non nil when Org parser should cache its results.")
+
+(defvar org-element--cache nil
+  "Hash table used as a cache for parser.
+Key is a buffer position and value is a cons cell with the
+pattern:
+
+  \(ELEMENT . OBJECTS-DATA)
+
+where ELEMENT is the element starting at the key and OBJECTS-DATA
+is an alist where each association is:
+
+  \(POS CANDIDATES . OBJECTS)
+
+where POS is a buffer position, CANDIDATES is the last know list
+of successors (see `org-element--get-next-object-candidates') in
+container starting at POS and OBJECTS is a list of objects known
+to live within that container, from farthest to closest.
+
+In the following example, \\alpha, bold object and \\beta start
+at, respectively, positions 1, 7 and 8,
+
+  \\alpha *\\beta*
+
+If the paragraph is completely parsed, OBJECTS-DATA will be
+
+  \((1 nil BOLD-OBJECT ENTITY-OBJECT)
+   \(8 nil ENTITY-OBJECT))
+
+whereas in a partially parsed paragraph, it could be
+
+  \((1 ((entity . 1) (bold . 7)) ENTITY-OBJECT))
+
+This cache is used in both `org-element-at-point' and
+`org-element-context'.  The former uses ELEMENT only and the
+latter OBJECTS-DATA only.")
+
+(defvar org-element--cache-sync-idle-time 0.5
+  "Number of seconds of idle time wait before syncing buffer cache.
+Syncing also happens when current modification is too distant
+from the stored one (for more information, see
+`org-element--cache-merge-changes-threshold').")
+
+(defvar org-element--cache-merge-changes-threshold 200
+  "Number of characters triggering cache syncing.
+
+The cache mechanism only stores one buffer modification at any
+given time.  When another change happens, it replaces it with
+a change containing both the stored modification and the current
+one.  This is a trade-off, as merging them prevents another
+syncing, but every element between them is then lost.
+
+This variable determines the maximum size, in characters, we
+accept to lose in order to avoid syncing the cache.")
+
+(defvar org-element--cache-status nil
+  "Contains data about cache validity for current buffer.
+
+Value is a vector of seven elements,
+
+  [ACTIVEP BEGIN END OFFSET TIMER PREVIOUS-STATE]
+
+ACTIVEP is a boolean non-nil when changes described in the other
+slots are valid for current buffer.
+
+BEGIN and END are the beginning and ending position of the area
+for which cache cannot be trusted.
+
+OFFSET it an integer specifying the number to add to position of
+elements after that area.
+
+TIMER is a timer used to apply these changes to cache when Emacs
+is idle.
+
+PREVIOUS-STATE is a symbol referring to the state of the buffer
+before a change happens.  It is used to know if sensitive
+areas (block boundaries, headlines) were modified.  It can be set
+to nil, `headline' or `other'.")
+
+;;;###autoload
+(defun org-element-cache-reset (&optional all)
+  "Reset cache in current buffer.
+When optional argument ALL is non-nil, reset cache in all Org
+buffers.  This function will do nothing if
+`org-element-use-cache' is nil."
+  (interactive "P")
+  (when org-element-use-cache
+    (dolist (buffer (if all (buffer-list) (list (current-buffer))))
+      (with-current-buffer buffer
+	(when (derived-mode-p 'org-mode)
+	  (if (org-bound-and-true-p org-element--cache)
+	      (clrhash org-element--cache)
+	    (org-set-local 'org-element--cache
+			   (make-hash-table :size 5003 :test 'eq)))
+	  (org-set-local 'org-element--cache-status (make-vector 6 nil))
+	  (add-hook 'before-change-functions
+		    'org-element--cache-before-change nil t)
+	  (add-hook 'after-change-functions
+		    'org-element--cache-record-change nil t))))))
+
+(defsubst org-element--cache-pending-changes-p ()
+  "Non-nil when changes are not integrated in cache yet."
+  (and org-element--cache-status
+       (aref org-element--cache-status 0)))
+
+(defsubst org-element--cache-push-change (beg end offset)
+  "Push change to current buffer staging area.
+BEG and END and the beginning and ending position of the
+modification area.  OFFSET is the size of the change, as an
+integer."
+  (aset org-element--cache-status 1 beg)
+  (aset org-element--cache-status 2 end)
+  (aset org-element--cache-status 3 offset)
+  (let ((timer (aref org-element--cache-status 4)))
+    (if timer (timer-activate-when-idle timer t)
+      (aset org-element--cache-status 4
+	    (run-with-idle-timer org-element--cache-sync-idle-time
+				 nil
+				 #'org-element--cache-sync
+				 (current-buffer)))))
+  (aset org-element--cache-status 0 t))
+
+(defsubst org-element--cache-cancel-changes ()
+  "Remove any cache change set for current buffer."
+  (let ((timer (aref org-element--cache-status 4)))
+    (and timer (cancel-timer timer)))
+  (aset org-element--cache-status 0 nil))
+
+(defsubst org-element--cache-get-key (element)
+  "Return expected key for ELEMENT in cache."
+  (let ((begin (org-element-property :begin element)))
+    (if (and (memq (org-element-type element) '(item table-row))
+	     (= (org-element-property :contents-begin
+				      (org-element-property :parent element))
+		begin))
+	;; Special key for first item (resp. table-row) in a plain
+	;; list (resp. table).
+	(1+ begin)
+      begin)))
+
+(defsubst org-element-cache-get (pos &optional type)
+  "Return data stored at key POS in current buffer cache.
+When optional argument TYPE is `element', retrieve the element
+starting at POS.  When it is `objects', return the list of object
+types along with their beginning position within that element.
+Otherwise, return the full data.  In any case, return nil if no
+data is found, or if caching is not allowed."
+  (when (and org-element-use-cache org-element--cache)
+    ;; If there are pending changes, first sync them.
+    (when (org-element--cache-pending-changes-p)
+      (org-element--cache-sync (current-buffer)))
+    (let ((data (gethash pos org-element--cache)))
+      (case type
+	(element (car data))
+	(objects (cdr data))
+	(otherwise data)))))
+
+(defsubst org-element-cache-put (pos data)
+  "Store data in current buffer's cache, if allowed.
+POS is a buffer position, which will be used as a key.  DATA is
+the value to store.  Nothing will be stored if
+`org-element-use-cache' is nil.  Return DATA in any case."
+  (if (not org-element-use-cache) data
+    (unless org-element--cache (org-element-cache-reset))
+    (puthash pos data org-element--cache)))
+
+(defsubst org-element--shift-positions (element offset)
+  "Shift ELEMENT properties relative to buffer positions by OFFSET.
+Properties containing buffer positions are `:begin', `:end',
+`:contents-begin', `:contents-end' and `:structure'.  They are
+modified by side-effect.  Return modified element."
+  (let ((properties (nth 1 element)))
+    ;; Shift :structure property for the first plain list only: it is
+    ;; the only one that really matters and it prevents from shifting
+    ;; it more than once.
+    (when (eq (car element) 'plain-list)
+      (let ((structure (plist-get properties :structure)))
+	(when (<= (plist-get properties :begin) (caar structure))
+	  (dolist (item structure)
+	    (incf (car item) offset)
+	    (incf (nth 6 item) offset)))))
+    (plist-put properties :begin (+ (plist-get properties :begin) offset))
+    (plist-put properties :end (+ (plist-get properties :end) offset))
+    (dolist (key '(:contents-begin :contents-end :post-affiliated))
+      (let ((value (plist-get properties key)))
+	(and value (plist-put properties key (+ offset value))))))
+  element)
+
+(defconst org-element--cache-opening-line
+  (concat "^[ \t]*\\(?:"
+	  "#\\+BEGIN[:_]" "\\|"
+	  "\\\\begin{[A-Za-z0-9]+\\*?}" "\\|"
+	  ":\\S-+:[ \t]*$"
+	  "\\)")
+  "Regexp matching an element opening line.
+When such a line is modified, modifications may propagate after
+modified area.  In that situation, every element between that
+area and next section is removed from cache.")
+
+(defconst org-element--cache-closing-line
+  (concat "^[ \t]*\\(?:"
+	  "#\\+END\\(?:_\\|:?[ \t]*$\\)" "\\|"
+	  "\\\\end{[A-Za-z0-9]+\\*?}[ \t]*$" "\\|"
+	  ":END:[ \t]*$"
+	  "\\)")
+  "Regexp matching an element closing line.
+When such a line is modified, modifications may propagate before
+modified area.  In that situation, every element between that
+area and previous section is removed from cache.")
+
+(defun org-element--cache-before-change (beg end)
+  "Request extension of area going to be modified if needed.
+BEG and END are the beginning and end of the range of changed
+text.  See `before-change-functions' for more information."
+  (let ((inhibit-quit t))
+    (org-with-wide-buffer
+     (goto-char beg)
+     (beginning-of-line)
+     (let ((top (point))
+	   (bottom (save-excursion (goto-char end) (line-end-position)))
+	   (sensitive-re
+	    ;; A sensitive line is a headline or a block (or drawer,
+	    ;; or latex-environment) boundary.  Inserting one can
+	    ;; modify buffer drastically both above and below that
+	    ;; line, possibly making cache invalid.  Therefore, we
+	    ;; need to pay special attention to changes happening to
+	    ;; them.
+	    (concat
+	     "\\(" (org-with-limited-levels org-outline-regexp-bol) "\\)" "\\|"
+	     org-element--cache-closing-line "\\|"
+	     org-element--cache-opening-line)))
+       (save-match-data
+	 (aset org-element--cache-status 5
+	       (cond ((not (re-search-forward sensitive-re bottom t)) nil)
+		     ((and (match-beginning 1)
+			   (progn (goto-char bottom)
+				  (or (not (re-search-backward sensitive-re
+							       (match-end 1) t))
+				      (match-beginning 1))))
+		      'headline)
+		     (t 'other))))))))
+
+(defun org-element--cache-record-change (beg end pre)
+  "Update buffer modifications for current buffer.
+
+BEG and END are the beginning and end of the range of changed
+text, and the length in bytes of the pre-change text replaced by
+that range.  See `after-change-functions' for more information.
+
+If there are already pending changes, try to merge them into
+a bigger change record.  If that's not possible, the function
+will first synchronize cache with previous change and store the
+new one."
+  (let ((inhibit-quit t))
+    (when (and org-element-use-cache org-element--cache)
+      (org-with-wide-buffer
+       (goto-char beg)
+       (beginning-of-line)
+       (let ((top (point))
+	     (bottom (save-excursion (goto-char end) (line-end-position))))
+	 (org-with-limited-levels
+	  (save-match-data
+	    ;; Determine if modified area needs to be extended,
+	    ;; according to both previous and current state.  We make
+	    ;; a special case for headline editing: if a headline is
+	    ;; modified but not removed, do not extend.
+	    (when (let ((previous-state (aref org-element--cache-status 5))
+			(sensitive-re
+			 (concat "\\(" org-outline-regexp-bol "\\)" "\\|"
+				 org-element--cache-closing-line "\\|"
+				 org-element--cache-opening-line)))
+		    (cond ((eq previous-state 'other))
+			  ((not (re-search-forward sensitive-re bottom t))
+			   (eq previous-state 'headline))
+			  ((match-beginning 1)
+			   (or (not (eq previous-state 'headline))
+			       (and (progn (goto-char bottom)
+					   (re-search-backward
+					    sensitive-re (match-end 1) t))
+				    (not (match-beginning 1)))))
+			  (t)))
+	      ;; Effectively extend modified area.
+	      (setq top (progn (goto-char top)
+			       (outline-previous-heading)
+			       ;; Headline above is inclusive.
+			       (point)))
+	      (setq bottom (progn (goto-char bottom)
+				  (outline-next-heading)
+				  ;; Headline below is exclusive.
+				  (if (eobp) (point) (1- (point))))))))
+	 ;; Store changes.
+	 (let ((offset (- end beg pre)))
+	   (if (not (org-element--cache-pending-changes-p))
+	       ;; No pending changes.  Store the new ones.
+	       (org-element--cache-push-change top (- bottom offset) offset)
+	     (let* ((current-start (aref org-element--cache-status 1))
+		    (current-end (+ (aref org-element--cache-status 2)
+				    (aref org-element--cache-status 3)))
+		    (gap (max (- beg current-end) (- current-start end))))
+	       (if (> gap org-element--cache-merge-changes-threshold)
+		   ;; If we cannot merge two change sets (i.e. they
+		   ;; modify distinct buffer parts) first apply current
+		   ;; change set and store new one.  This way, there is
+		   ;; never more than one pending change set, which
+		   ;; avoids handling costly merges.
+		   (progn (org-element--cache-sync (current-buffer))
+			  (org-element--cache-push-change
+			   top (- bottom offset) offset))
+		 ;; Change sets can be merged.  We can expand the area
+		 ;; that requires an update, and postpone the sync.
+		 (timer-activate-when-idle (aref org-element--cache-status 4) t)
+		 (aset org-element--cache-status 0 t)
+		 (aset org-element--cache-status 1 (min top current-start))
+		 (aset org-element--cache-status 2
+		       (- (max current-end bottom) offset))
+		 (incf (aref org-element--cache-status 3) offset))))))))))
+
+(defun org-element--cache-sync (buffer)
+  "Synchronize cache with recent modification in BUFFER.
+Elements ending before modification area are kept in cache.
+Elements starting after modification area have their position
+shifted by the size of the modification.  Every other element is
+removed from the cache."
+  (when (buffer-live-p buffer)
+    (with-current-buffer buffer
+      (when (org-element--cache-pending-changes-p)
+	(let ((inhibit-quit t)
+	      (beg (aref org-element--cache-status 1))
+	      (end (aref org-element--cache-status 2))
+	      (offset (aref org-element--cache-status 3))
+	      new-keys)
+	  (maphash
+	   #'(lambda (key value)
+	       (cond
+		((memq key new-keys))
+		((> key end)
+		 ;; Shift every element starting after END by OFFSET.
+		 ;; We also need to shift keys, since they refer to
+		 ;; buffer positions.
+		 ;;
+		 ;; Upon shifting a key a conflict can occur if the
+		 ;; shifted key also refers to some element in the
+		 ;; cache.  In this case, we temporarily associate
+		 ;; both elements, as a cons cell, to the shifted key,
+		 ;; following the pattern (SHIFTED . CURRENT).
+		 ;;
+		 ;; Such a conflict can only occur if shifted key hash
+		 ;; hasn't been processed by `maphash' yet.
+		 (unless (zerop offset)
+		   (let* ((conflictp (consp (caar value)))
+			  (value-to-shift (if conflictp (cdr value) value)))
+		     ;; Shift element part.
+		     (org-element--shift-positions (car value-to-shift) offset)
+		     ;; Shift objects part.
+		     (dolist (object-data (cdr value-to-shift))
+		       (incf (car object-data) offset)
+		       (dolist (successor (nth 1 object-data))
+			 (incf (cdr successor) offset))
+		       (dolist (object (cddr object-data))
+			 (org-element--shift-positions object offset)))
+		     ;; Shift key-value pair.
+		     (let* ((new-key (+ key offset))
+			    (new-value (gethash new-key org-element--cache)))
+		       ;; Put new value to shifted key.
+		       ;;
+		       ;; If one already exists, do not overwrite it:
+		       ;; store it as the car of a cons cell instead,
+		       ;; and handle it when `maphash' reaches
+		       ;; NEW-KEY.
+		       ;;
+		       ;; If there is no element stored at NEW-KEY or
+		       ;; if NEW-KEY is going to be removed anyway
+		       ;; (i.e., it is before END), just store new
+		       ;; value there and make sure it will not be
+		       ;; processed again by storing NEW-KEY in
+		       ;; NEW-KEYS.
+		       (puthash new-key
+				(if (and new-value (> new-key end))
+				    (cons value-to-shift new-value)
+				  (push new-key new-keys)
+				  value-to-shift)
+				org-element--cache)
+		       ;; If current value contains two elements, car
+		       ;; should be the new value, since cdr has been
+		       ;; shifted already.
+		       (if conflictp
+			   (puthash key (car value) org-element--cache)
+			 (remhash key org-element--cache))))))
+		;; Remove every element between BEG and END, since
+		;; this is where changes happened.
+		((>= key beg) (remhash key org-element--cache))
+		;; Preserve any element ending before BEG.  If it
+		;; overlaps the BEG-END area, remove it.
+		(t (or (< (org-element-property :end (car value)) beg)
+		       (remhash key org-element--cache)))))
+	   org-element--cache)
+	  ;; Signal cache as up-to-date.
+	  (org-element--cache-cancel-changes))))))
 
 ;;;###autoload
 (defun org-element-at-point (&optional keep-trail)
@@ -4687,96 +5097,124 @@ first element of current section."
    (if (org-with-limited-levels (org-at-heading-p))
        (progn
 	 (beginning-of-line)
-	 (if (not keep-trail) (org-element-headline-parser (point-max) t)
-	   (list (org-element-headline-parser (point-max) t))))
+	 (let ((headline
+		(or (org-element-cache-get (point) 'element)
+		    (car (org-element-cache-put
+			  (point)
+			  (list (org-element-headline-parser
+				 (point-max) t)))))))
+	   (if keep-trail (list headline) headline)))
      ;; Otherwise move at the beginning of the section containing
      ;; point.
      (catch 'exit
-       (let ((origin (point))
-	     (end (save-excursion
-		    (org-with-limited-levels (outline-next-heading)) (point)))
-	     element type special-flag trail struct prevs parent)
-	 (org-with-limited-levels
-	  (if (org-before-first-heading-p)
-	      ;; In empty lines at buffer's beginning, return nil.
-	      (progn (goto-char (point-min))
-		     (org-skip-whitespace)
-		     (when (or (eobp) (> (line-beginning-position) origin))
-		       (throw 'exit nil)))
-	    (org-back-to-heading)
-	    (forward-line)
-	    (org-skip-whitespace)
-	    (when (or (eobp) (> (line-beginning-position) origin))
-	      ;; In blank lines just after the headline, point still
-	      ;; belongs to the headline.
-	      (throw 'exit
-		     (progn (skip-chars-backward " \r\t\n")
-			    (beginning-of-line)
-			    (if (not keep-trail)
-				(org-element-headline-parser (point-max) t)
-			      (list (org-element-headline-parser
-				     (point-max) t))))))))
+       (let ((origin (point)))
+	 (if (not (org-with-limited-levels (outline-previous-heading)))
+	     ;; In empty lines at buffer's beginning, return nil.
+	     (progn (goto-char (point-min))
+		    (org-skip-whitespace)
+		    (when (or (eobp) (> (line-beginning-position) origin))
+		      (throw 'exit nil)))
+	   (forward-line)
+	   (org-skip-whitespace)
+	   (when (or (eobp) (> (line-beginning-position) origin))
+	     ;; In blank lines just after the headline, point still
+	     ;; belongs to the headline.
+	     (throw 'exit
+		    (progn
+		      (skip-chars-backward " \r\t\n")
+		      (beginning-of-line)
+		      (let ((headline
+			     (or (org-element-cache-get (point) 'element)
+				 (car (org-element-cache-put
+				       (point)
+				       (list (org-element-headline-parser
+					      (point-max) t)))))))
+			(if keep-trail (list headline) headline))))))
 	 (beginning-of-line)
-	 ;; Parse successively each element, skipping those ending
-	 ;; before original position.
-	 (while t
-	   (setq element
-		 (org-element--current-element end 'element special-flag struct)
-		 type (car element))
-	   (org-element-put-property element :parent parent)
-	   (when keep-trail (push element trail))
-	   (cond
-	    ;; 1. Skip any element ending before point.  Also skip
-	    ;;    element ending at point when we're sure that another
-	    ;;    element has started.
-	    ((let ((elem-end (org-element-property :end element)))
-	       (when (or (< elem-end origin)
-			 (and (= elem-end origin) (/= elem-end end)))
-		 (goto-char elem-end))))
-	    ;; 2. An element containing point is always the element at
-	    ;;    point.
-	    ((not (memq type org-element-greater-elements))
-	     (throw 'exit (if keep-trail trail element)))
-	    ;; 3. At any other greater element type, if point is
-	    ;;    within contents, move into it.
-	    (t
-	     (let ((cbeg (org-element-property :contents-begin element))
-		   (cend (org-element-property :contents-end element)))
-	       (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
-		       ;; Create an anchor for tables and plain lists:
-		       ;; when point is at the very beginning of these
-		       ;; elements, ignoring affiliated keywords,
-		       ;; target them instead of their contents.
-		       (and (= cbeg origin) (memq type '(plain-list table)))
-		       ;; When point is at contents end, do not move
-		       ;; into elements with an explicit ending, but
-		       ;; return that element instead.
-		       (and (= cend origin)
-			    (or (memq type
-				      '(center-block
-					drawer dynamic-block inlinetask
-					property-drawer quote-block
-					special-block))
-				;; Corner case: if a list ends at the
-				;; end of a buffer without a final new
-				;; line, return last element in last
-				;; item instead.
-				(and (memq type '(item plain-list))
-				     (progn (goto-char cend)
-					    (or (bolp) (not (eobp))))))))
-		   (throw 'exit (if keep-trail trail element))
-		 (setq parent element)
-		 (case type
-		   (plain-list
-		    (setq special-flag 'item
-			  struct (org-element-property :structure element)))
-		   (item (setq special-flag nil))
-		   (property-drawer
-		    (setq special-flag 'node-property struct nil))
-		   (table (setq special-flag 'table-row struct nil))
-		   (otherwise (setq special-flag nil struct nil)))
-		 (setq end cend)
-		 (goto-char cbeg)))))))))))
+	 (let ((end (save-excursion
+		      (org-with-limited-levels (outline-next-heading)) (point)))
+	       element type special-flag trail struct parent)
+	   ;; Parse successively each element, skipping those ending
+	   ;; before original position.
+	   (while t
+	     (setq element
+		   (let* ((pos (if (and (memq special-flag '(item table-row))
+					(memq type '(plain-list table)))
+				   ;; First item (resp. row) in plain
+				   ;; list (resp. table) gets
+				   ;; a special key in cache.
+				   (1+ (point))
+				 (point)))
+			  (cached (org-element-cache-get pos 'element)))
+		     (cond
+		      ((not cached)
+		       (let ((element (org-element--current-element
+				       end 'element special-flag struct)))
+			 (when (derived-mode-p 'org-mode)
+			   (org-element-cache-put pos (cons element nil)))
+			 element))
+		      ;; When changes happened in the middle of a list,
+		      ;; its structure ends up being invalid.
+		      ;; Therefore, we make sure to use a valid one.
+		      ((and struct (memq (car cached) '(item plain-list)))
+		       (org-element-put-property cached :structure struct))
+		      (t cached))))
+	     (setq type (org-element-type element))
+	     (org-element-put-property element :parent parent)
+	     (when keep-trail (push element trail))
+	     (cond
+	      ;; 1. Skip any element ending before point.  Also skip
+	      ;;    element ending at point when we're sure that
+	      ;;    another element has started.
+	      ((let ((elem-end (org-element-property :end element)))
+		 (when (or (< elem-end origin)
+			   (and (= elem-end origin) (/= elem-end end)))
+		   (goto-char elem-end))))
+	      ;; 2. An element containing point is always the element at
+	      ;;    point.
+	      ((not (memq type org-element-greater-elements))
+	       (throw 'exit (if keep-trail trail element)))
+	      ;; 3. At any other greater element type, if point is
+	      ;;    within contents, move into it.
+	      (t
+	       (let ((cbeg (org-element-property :contents-begin element))
+		     (cend (org-element-property :contents-end element)))
+		 (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
+			 ;; Create an anchor for tables and plain
+			 ;; lists: when point is at the very beginning
+			 ;; of these elements, ignoring affiliated
+			 ;; keywords, target them instead of their
+			 ;; contents.
+			 (and (= cbeg origin) (memq type '(plain-list table)))
+			 ;; When point is at contents end, do not move
+			 ;; into elements with an explicit ending, but
+			 ;; return that element instead.
+			 (and (= cend origin)
+			      (or (memq type
+					'(center-block
+					  drawer dynamic-block inlinetask
+					  property-drawer quote-block
+					  special-block))
+				  ;; Corner case: if a list ends at
+				  ;; the end of a buffer without
+				  ;; a final new line, return last
+				  ;; element in last item instead.
+				  (and (memq type '(item plain-list))
+				       (progn (goto-char cend)
+					      (or (bolp) (not (eobp))))))))
+		     (throw 'exit (if keep-trail trail element))
+		   (setq parent element)
+		   (case type
+		     (plain-list
+		      (setq special-flag 'item
+			    struct (org-element-property :structure element)))
+		     (item (setq special-flag nil))
+		     (property-drawer
+		      (setq special-flag 'node-property struct nil))
+		     (table (setq special-flag 'table-row struct nil))
+		     (otherwise (setq special-flag nil struct nil)))
+		   (setq end cend)
+		   (goto-char cbeg))))))))))))
 
 ;;;###autoload
 (defun org-element-context (&optional element)
@@ -4798,11 +5236,10 @@ Providing it allows for quicker computation."
     (org-with-wide-buffer
      (let* ((origin (point))
             (element (or element (org-element-at-point)))
-            (type (org-element-type element))
-            context)
-       ;; Check if point is inside an element containing objects or at
-       ;; a secondary string.  In that case, narrow buffer to the
-       ;; containing area.  Otherwise, return ELEMENT.
+            (type (org-element-type element)))
+       ;; If point is inside an element containing objects or
+       ;; a secondary string, narrow buffer to the container and
+       ;; proceed with parsing.  Otherwise, return ELEMENT.
        (cond
 	;; At a parsed affiliated keyword, check if we're inside main
 	;; or dual value.
@@ -4832,8 +5269,7 @@ Providing it allows for quicker computation."
 	     (if (and (>= origin (point)) (< origin (match-end 0)))
 		 (narrow-to-region (point) (match-end 0))
 	       (throw 'objects-forbidden element)))))
-	;; At an headline or inlinetask, objects are located within
-	;; their title.
+	;; At an headline or inlinetask, objects are in title.
 	((memq type '(headline inlinetask))
 	 (goto-char (org-element-property :begin element))
 	 (skip-chars-forward "* ")
@@ -4859,44 +5295,92 @@ Providing it allows for quicker computation."
 	   (if (and (>= origin (point)) (< origin (line-end-position)))
 	       (narrow-to-region (point) (line-end-position))
 	     (throw 'objects-forbidden element))))
+	;; All other locations cannot contain objects: bail out.
 	(t (throw 'objects-forbidden element)))
        (goto-char (point-min))
-       (let ((restriction (org-element-restriction type))
-             (parent element)
-             (candidates 'initial))
-         (catch 'exit
-           (while (setq candidates
-			(org-element--get-next-object-candidates
-			 restriction candidates))
-             (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
-                                        candidates)))
-               ;; If ORIGIN is before next object in element, there's
-               ;; no point in looking further.
-               (if (> (cdr closest-cand) origin) (throw 'exit parent)
-                 (let* ((object
-                         (progn (goto-char (cdr closest-cand))
-                                (funcall (intern (format "org-element-%s-parser"
-                                                         (car closest-cand))))))
-                        (cbeg (org-element-property :contents-begin object))
-                        (cend (org-element-property :contents-end object))
-                        (obj-end (org-element-property :end object)))
-                   (cond
-                    ;; ORIGIN is after OBJECT, so skip it.
-                    ((<= obj-end origin) (goto-char obj-end))
-                    ;; ORIGIN is within a non-recursive object or at
-                    ;; an object boundaries: Return that object.
-                    ((or (not cbeg) (< origin cbeg) (>= origin cend))
-                     (throw 'exit
-                            (org-element-put-property object :parent parent)))
-                    ;; Otherwise, move within current object and
-                    ;; restrict search to the end of its contents.
-                    (t (goto-char cbeg)
-                       (narrow-to-region (point) cend)
-                       (org-element-put-property object :parent parent)
-                       (setq parent object
-                             restriction (org-element-restriction object)
-                             candidates 'initial)))))))
-           parent))))))
+       (let* ((restriction (org-element-restriction type))
+	      (parent element)
+	      (candidates 'initial)
+	      (cache-key (org-element--cache-get-key element))
+	      (cache (org-element-cache-get cache-key 'objects))
+	      objects-data next update-cache-flag)
+	 (prog1
+	     (catch 'exit
+	       (while t
+		 ;; Get list of next object candidates in CANDIDATES.
+		 ;; When entering for the first time PARENT, grab it
+		 ;; from cache, if available, or compute it.  Then,
+		 ;; for each subsequent iteration in PARENT, always
+		 ;; compute it since we're beyond cache anyway.
+		 (when (and (not next) org-element-use-cache)
+		   (let ((data (assq (point) cache)))
+		     (if data (setq candidates (nth 1 (setq objects-data data)))
+		       (push (setq objects-data (list (point) 'initial))
+			     cache))))
+		 (when (or next (eq 'initial candidates))
+		   (setq candidates
+			 (org-element--get-next-object-candidates
+			  restriction candidates))
+		   (when org-element-use-cache
+		     (setcar (cdr objects-data) candidates)
+		     (or update-cache-flag (setq update-cache-flag t))))
+		 ;; Compare ORIGIN with next object starting position,
+		 ;; if any.
+		 ;;
+		 ;; If ORIGIN is lesser or if there is no object
+		 ;; following, look for a previous object that might
+		 ;; contain it in cache.  If there is no cache, we
+		 ;; didn't miss any object so simply return PARENT.
+		 ;;
+		 ;; If ORIGIN is greater or equal, parse next
+		 ;; candidate for further processing.
+		 (let ((closest
+			(and candidates
+			     (rassq (apply #'min (mapcar #'cdr candidates))
+				    candidates))))
+		   (if (or (not closest) (> (cdr closest) origin))
+		       (catch 'found
+			 (dolist (obj (cddr objects-data) (throw 'exit parent))
+			   (when (<= (org-element-property :begin obj) origin)
+			     (if (<= (org-element-property :end obj) origin)
+				 ;; Object ends before ORIGIN and we
+				 ;; know next one in cache starts
+				 ;; after it: bail out.
+				 (throw 'exit parent)
+			       (throw 'found (setq next obj))))))
+		     (goto-char (cdr closest))
+		     (setq next
+			   (funcall (intern (format "org-element-%s-parser"
+						    (car closest)))))
+		     (when org-element-use-cache
+		       (push next (cddr objects-data))
+		       (or update-cache-flag (setq update-cache-flag t)))))
+		 ;; Process NEXT to know if we need to skip it, return
+		 ;; it or move into it.
+		 (let ((cbeg (org-element-property :contents-begin next))
+		       (cend (org-element-property :contents-end next))
+		       (obj-end (org-element-property :end next)))
+		   (cond
+		    ;; ORIGIN is after NEXT, so skip it.
+		    ((<= obj-end origin) (goto-char obj-end))
+		    ;; ORIGIN is within a non-recursive next or
+		    ;; at an object boundaries: Return that object.
+		    ((or (not cbeg) (< origin cbeg) (>= origin cend))
+		     (throw 'exit
+			    (org-element-put-property next :parent parent)))
+		    ;; Otherwise, move into NEXT and reset flags as we
+		    ;; shift parent.
+		    (t (goto-char cbeg)
+		       (narrow-to-region (point) cend)
+		       (org-element-put-property next :parent parent)
+		       (setq parent next
+			     restriction (org-element-restriction next)
+			     next nil
+			     objects-data nil
+			     candidates 'initial))))))
+	   ;; Update cache if required.
+	   (when (and update-cache-flag (derived-mode-p 'org-mode))
+	     (org-element-cache-put cache-key (cons element cache)))))))))
 
 (defun org-element-nested-p (elem-A elem-B)
   "Non-nil when elements ELEM-A and ELEM-B are nested."
diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el
index 3c0d97c..c59bd0c 100644
--- a/lisp/org-footnote.el
+++ b/lisp/org-footnote.el
@@ -106,8 +106,15 @@ the notes.  However, by hand you may place definitions
 *anywhere*.
 
 If this is a string, during export, all subtrees starting with
-this heading will be ignored."
+this heading will be ignored.
+
+If you don't use the customize interface to change this variable,
+you will need to run the following command after the change:
+
+  \\[universal-argument] \\[org-element-cache-reset]"
   :group 'org-footnote
+  :initialize 'custom-initialize-set
+  :set (lambda (var val) (set var val) (org-element-cache-reset 'all))
   :type '(choice
 	  (string :tag "Collect footnotes under heading")
 	  (const :tag "Define footnotes locally" nil)))
diff --git a/lisp/org-src.el b/lisp/org-src.el
index 6ec3adc..918c1ba 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -116,15 +116,24 @@ These are the regions where each line starts with a colon."
 	  (function :tag "Other (specify)")))
 
 (defcustom org-src-preserve-indentation nil
-  "If non-nil preserve leading whitespace characters on export.
-If non-nil leading whitespace characters in source code blocks
-are preserved on export, and when switching between the org
-buffer and the language mode edit buffer.  If this variable is nil
-then, after editing with \\[org-edit-src-code], the
-minimum (across-lines) number of leading whitespace characters
-are removed from all lines, and the code block is uniformly
-indented according to the value of `org-edit-src-content-indentation'."
+  "\\<org-mode-map>If non-nil preserve leading whitespace characters on export.
+
+If non-nil leading whitespace characters in source code blocks are
+preserved on export, and when switching between the org buffer and
+the language mode edit buffer.
+
+If this variable is nil then, after editing with \\[org-edit-src-code],
+or \\[org-edit-special], the minimum (across-lines) number of leading whitespace
+characters are removed from all lines, and the code block is uniformly
+indented according to the value of `org-edit-src-content-indentation'.
+
+If you don't use the customize interface to change this variable,
+you will need to run the following command after the change:
+
+  \\[universal-argument] \\[org-element-cache-reset]"
   :group 'org-edit-structure
+  :initialize 'custom-initialize-set
+  :set (lambda (var val) (set var val) (org-element-cache-reset 'all))
   :type 'boolean)
 
 (defcustom org-edit-src-content-indentation 2
diff --git a/lisp/org.el b/lisp/org.el
index 0fd531d..e331ace 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -140,6 +140,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
 (declare-function org-element--parse-objects "org-element"
 		  (beg end acc restriction))
 (declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-cache-reset "org-element" (&optional all))
 (declare-function org-element-contents "org-element" (element))
 (declare-function org-element-context "org-element" (&optional element))
 (declare-function org-element-interpret-data "org-element"
@@ -357,7 +358,8 @@ When MESSAGE is non-nil, display a message with the version."
   "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
   (set var value)
   (when (featurep 'org)
-    (org-load-modules-maybe 'force)))
+    (org-load-modules-maybe 'force)
+    (org-element-cache-reset 'all)))
 
 (defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail)
   "Modules that should always be loaded together with org.el.
@@ -5391,6 +5393,8 @@ The following commands are available:
   (org-setup-filling)
   ;; Comments.
   (org-setup-comments-handling)
+  ;; Initialize cache.
+  (org-element-cache-reset)
   ;; Beginning/end of defun
   (org-set-local 'beginning-of-defun-function 'org-backward-element)
   (org-set-local 'end-of-defun-function 'org-forward-element)
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 103ba99..ebf6913 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -858,25 +858,29 @@ Some other text
 (ert-deftest test-org-element/headline-archive-tag ()
   "Test ARCHIVE tag recognition."
   ;; Reference test.
-  (org-test-with-temp-text "* Headline"
-    (let ((org-archive-tag "ARCHIVE"))
-      (should-not (org-element-property :archivedp (org-element-at-point)))))
+  (should-not
+   (org-test-with-temp-text "* Headline"
+     (let ((org-archive-tag "ARCHIVE"))
+       (org-element-property :archivedp (org-element-at-point)))))
   ;; Single tag.
   (org-test-with-temp-text "* Headline :ARCHIVE:"
     (let ((org-archive-tag "ARCHIVE"))
       (let ((headline (org-element-at-point)))
 	(should (org-element-property :archivedp headline))
 	;; Test tag removal.
-	(should-not (org-element-property :tags headline))))
-    (let ((org-archive-tag "Archive"))
-      (should-not (org-element-property :archivedp (org-element-at-point)))))
+	(should-not (org-element-property :tags headline)))))
   ;; Multiple tags.
   (org-test-with-temp-text "* Headline :test:ARCHIVE:"
     (let ((org-archive-tag "ARCHIVE"))
       (let ((headline (org-element-at-point)))
 	(should (org-element-property :archivedp headline))
 	;; Test tag removal.
-	(should (equal (org-element-property :tags headline) '("test")))))))
+	(should (equal (org-element-property :tags headline) '("test"))))))
+  ;; Tag is case-sensitive.
+  (should-not
+   (org-test-with-temp-text "* Headline :ARCHIVE:"
+     (let ((org-archive-tag "Archive"))
+       (org-element-property :archivedp (org-element-at-point))))))
 
 (ert-deftest test-org-element/headline-properties ()
   "Test properties from property drawer."
-- 
1.8.4.1