Browse Source

org-element: Remove object caching

* lisp/org-element.el (org-element--cache-objects): Remove variable.
(org-element--cache-put):
(org-element--cache-remove):
(org-element--cache-process-request):
(org-element-cache-reset):
(org-element-context): Apply removal.

Caching objects is complicated and doesn't buy much in most cases,
since a change in an element reset the whole objects cache for that
element.
Nicolas Goaziou 8 years ago
parent
commit
5bd340fd4e
1 changed files with 63 additions and 156 deletions
  1. 63 156
      lisp/org-element.el

+ 63 - 156
lisp/org-element.el

@@ -4797,9 +4797,6 @@ indentation removed from its contents."
 ;; associated to a key, obtained with `org-element--cache-key'.  This
 ;; mechanism is robust enough to preserve total order among elements
 ;; even when the tree is only partially synchronized.
-;;
-;; Objects contained in an element are stored in a hash table,
-;; `org-element--cache-objects'.
 
 
 (defvar org-element-use-cache t
@@ -4828,34 +4825,6 @@ 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:
-
-  (PARENT COMPLETEP . OBJECTS)
-
-where PARENT is an element or object, COMPLETEP is a boolean,
-non-nil when all direct children of parent are already cached and
-OBJECTS is a list of such children, as objects, from farthest to
-closest.
-
-In the following example, \\alpha, bold object and \\beta are
-contained within a paragraph
-
-  \\alpha *\\beta*
-
-If the paragraph is completely parsed, OBJECTS-DATA will be
-
-  ((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT)
-   (BOLD-OBJECT t ENTITY-OBJECT))
-
-whereas in a partially parsed paragraph, it could be
-
-  ((PARAGRAPH nil ENTITY-OBJECT))
-
-This cache is used in `org-element-context'.")
-
 (defvar org-element--cache-sync-requests nil
   "List of pending synchronization requests.
 
@@ -5092,36 +5061,28 @@ the cache."
       (`nil lower)
       (_ upper))))
 
-(defun org-element--cache-put (element &optional data)
-  "Store ELEMENT in current buffer's cache, if allowed.
-When optional argument DATA is non-nil, assume is it object data
-relative to ELEMENT and store it in the objects cache."
-  (cond ((not (org-element--cache-active-p)) nil)
-	((not data)
-	 (when org-element--cache-sync-requests
-	   ;; During synchronization, first build an appropriate key
-	   ;; for the new element so `avl-tree-enter' can insert it at
-	   ;; the right spot in the cache.
-	   (let ((keys (org-element--cache-find
-			(org-element-property :begin element) 'both)))
-	     (puthash element
-		      (org-element--cache-generate-key
-		       (and (car keys) (org-element--cache-key (car keys)))
-		       (cond ((cdr keys) (org-element--cache-key (cdr keys)))
-			     (org-element--cache-sync-requests
-			      (aref (car org-element--cache-sync-requests) 0))))
-		      org-element--cache-sync-keys)))
-	 (avl-tree-enter org-element--cache element))
-	;; Headlines are not stored in cache, so objects in titles are
-	;; not stored either.
-	((eq (org-element-type element) 'headline) nil)
-	(t (puthash element data org-element--cache-objects))))
+(defun org-element--cache-put (element)
+  "Store ELEMENT in current buffer's cache, if allowed."
+  (when (org-element--cache-active-p)
+    (when org-element--cache-sync-requests
+      ;; During synchronization, first build an appropriate key for
+      ;; the new element so `avl-tree-enter' can insert it at the
+      ;; right spot in the cache.
+      (let ((keys (org-element--cache-find
+		   (org-element-property :begin element) 'both)))
+	(puthash element
+		 (org-element--cache-generate-key
+		  (and (car keys) (org-element--cache-key (car keys)))
+		  (cond ((cdr keys) (org-element--cache-key (cdr keys)))
+			(org-element--cache-sync-requests
+			 (aref (car org-element--cache-sync-requests) 0))))
+		 org-element--cache-sync-keys)))
+    (avl-tree-enter org-element--cache element)))
 
 (defsubst org-element--cache-remove (element)
   "Remove ELEMENT from cache.
 Assume ELEMENT belongs to cache and that a cache is active."
-  (avl-tree-delete org-element--cache element)
-  (remhash element org-element--cache-objects))
+  (avl-tree-delete org-element--cache element))
 
 
 ;;;; Synchronization
@@ -5377,11 +5338,7 @@ request."
 		(throw 'interrupt nil))
 	      ;; Shift element.
 	      (unless (zerop offset)
-		(org-element--cache-shift-positions data offset)
-		;; Shift associated objects data, if any.
-		(dolist (object-data (gethash data org-element--cache-objects))
-		  (dolist (object (cddr object-data))
-		    (org-element--cache-shift-positions object offset))))
+		(org-element--cache-shift-positions data offset))
 	      (let ((begin (org-element-property :begin data)))
 		;; Update PARENT and re-parent DATA, only when
 		;; necessary.  Propagate new structures for lists.
@@ -5747,7 +5704,6 @@ buffers."
       (when (and org-element-use-cache (derived-mode-p 'org-mode))
 	(setq-local org-element--cache
 		    (avl-tree-create #'org-element--cache-compare))
-	(setq-local org-element--cache-objects (make-hash-table :test #'eq))
 	(setq-local org-element--cache-sync-keys
 		    (make-hash-table :weakness 'key :test #'eq))
 	(setq-local org-element--cache-change-warning nil)
@@ -5919,99 +5875,50 @@ Providing it allows for quicker computation."
        (goto-char (point-min))
        (let ((restriction (org-element-restriction type))
 	     (parent element)
-	     (cache (cond ((not (org-element--cache-active-p)) nil)
-			  (org-element--cache-objects
-			   (gethash element org-element--cache-objects))
-			  (t (org-element-cache-reset) nil)))
-	     next object-data last)
-	 (prog1
-	     (catch 'exit
-	       (while t
-		 ;; When entering PARENT for the first time, get list
-		 ;; of objects within known so far.  Store it in
-		 ;; OBJECT-DATA.
-		 (unless next
-		   (let ((data (assq parent cache)))
-		     (if data (setq object-data data)
-		       (push (setq object-data (list parent nil)) cache))))
-		 ;; Find NEXT object for analysis.
-		 (catch 'found
-		   ;; If NEXT is non-nil, we already exhausted the
-		   ;; cache so we can parse buffer to find the object
-		   ;; after it.
-		   (if next (setq next (org-element--object-lex restriction))
-		     ;; Otherwise, check if cache can help us.
-		     (let ((objects (cddr object-data))
-			   (completep (nth 1 object-data)))
-		       (cond
-			((and (not objects) completep) (throw 'exit parent))
-			((not objects)
-			 (setq next (org-element--object-lex restriction)))
-			(t
-			 (let ((cache-limit
-				(org-element-property :end (car objects))))
-			   (if (>= cache-limit pos)
-			       ;; Cache contains the information needed.
-			       (dolist (object objects (throw 'exit parent))
-				 (when (<= (org-element-property :begin object)
-					   pos)
-				   (if (>= (org-element-property :end object)
-					   pos)
-				       (throw 'found (setq next object))
-				     (throw 'exit parent))))
-			     (goto-char cache-limit)
-			     (setq next
-				   (org-element--object-lex restriction))))))))
-		   ;; If we have a new object to analyze, store it in
-		   ;; cache.  Otherwise record that there is nothing
-		   ;; more to parse in this element at this depth.
-		   (if next
-		       (progn (org-element-put-property next :parent parent)
-			      (push next (cddr object-data)))
-		     (setcar (cdr object-data) t)))
-		 ;; Process NEXT, if any, in order to know if we need
-		 ;; to skip it, return it or move into it.
-		 (if (or (not next) (> (org-element-property :begin next) pos))
-		     (throw 'exit (or last parent))
-		   (let ((end (org-element-property :end next))
-			 (cbeg (org-element-property :contents-begin next))
-			 (cend (org-element-property :contents-end next)))
-		     (cond
-		      ;; Skip objects ending before point.  Also skip
-		      ;; objects ending at point unless it is also the
-		      ;; end of buffer, since we want to return the
-		      ;; innermost object.
-		      ((and (<= end pos) (/= (point-max) end))
-		       (goto-char end)
-		       ;; For convenience, when object ends at POS,
-		       ;; without any space, store it in LAST, as we
-		       ;; will return it if no object starts here.
-		       (when (and (= end pos)
-				  (not (memq (char-before) '(?\s ?\t))))
-			 (setq last next)))
-		      ;; If POS is within a container object, move
-		      ;; into that object.
-		      ((and cbeg cend
-			    (>= pos cbeg)
-			    (or (< pos cend)
-				;; At contents' end, if there is no
-				;; space before point, also move into
-				;; object, for consistency with
-				;; convenience feature above.
-				(and (= pos cend)
-				     (or (= (point-max) pos)
-					 (not (memq (char-before pos)
-						    '(?\s ?\t)))))))
-		       (goto-char cbeg)
-		       (narrow-to-region (point) cend)
-		       (setq parent next
-			     restriction (org-element-restriction next)
-			     next nil
-			     object-data nil))
-		      ;; Otherwise, return NEXT.
-		      (t (throw 'exit next)))))))
-	   ;; Store results in cache, if applicable.
-	   (org-element--cache-put element cache)))))))
+	     last)
+	 (catch 'exit
+	   (while t
+	     (let ((next (org-element--object-lex restriction)))
+	       (when next (org-element-put-property next :parent parent))
+	       ;; Process NEXT, if any, in order to know if we need to
+	       ;; skip it, return it or move into it.
+	       (if (or (not next) (> (org-element-property :begin next) pos))
+		   (throw 'exit (or last parent))
+		 (let ((end (org-element-property :end next))
+		       (cbeg (org-element-property :contents-begin next))
+		       (cend (org-element-property :contents-end next)))
+		   (cond
+		    ;; Skip objects ending before point.  Also skip
+		    ;; objects ending at point unless it is also the
+		    ;; end of buffer, since we want to return the
+		    ;; innermost object.
+		    ((and (<= end pos) (/= (point-max) end))
+		     (goto-char end)
+		     ;; For convenience, when object ends at POS,
+		     ;; without any space, store it in LAST, as we
+		     ;; will return it if no object starts here.
+		     (when (and (= end pos)
+				(not (memq (char-before) '(?\s ?\t))))
+		       (setq last next)))
+		    ;; If POS is within a container object, move into
+		    ;; that object.
+		    ((and cbeg cend
+			  (>= pos cbeg)
+			  (or (< pos cend)
+			      ;; At contents' end, if there is no
+			      ;; space before point, also move into
+			      ;; object, for consistency with
+			      ;; convenience feature above.
+			      (and (= pos cend)
+				   (or (= (point-max) pos)
+				       (not (memq (char-before pos)
+						  '(?\s ?\t)))))))
+		     (goto-char cbeg)
+		     (narrow-to-region (point) cend)
+		     (setq parent next)
+		     (setq restriction (org-element-restriction next)))
+		    ;; Otherwise, return NEXT.
+		    (t (throw 'exit next)))))))))))))
 
 (defun org-element-lineage (blob &optional types with-self)
   "List all ancestors of a given element or object.