Browse Source

org-element: Fix cache bug for orphaned elements

* lisp/org-element.el (org-element--cache-sync-requests): Remove a now
  useless element from requests
(org-element--cache-submit-request): Apply change to sync request.
(org-element--cache-process-request): Apply change to sync requests.
Fix removal of orphaned elements, i.e., elements not affected by
a change, but with an ancestor that was.

* testing/lisp/test-org-element.el (test-org-element/cache): Add test.

Reported-by: Suvayu Ali <fatkasuvayu+linux@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/98260>
Nicolas Goaziou 9 years ago
parent
commit
182ff104b7
2 changed files with 78 additions and 66 deletions
  1. 63 65
      lisp/org-element.el
  2. 15 1
      testing/lisp/test-org-element.el

+ 63 - 65
lisp/org-element.el

@@ -4688,7 +4688,7 @@ This cache is used in `org-element-context'.")
 
 
 A request is a vector with the following pattern:
 A request is a vector with the following pattern:
 
 
- \[NEXT BEG END OFFSET OUTREACH PARENT PHASE]
+ \[NEXT BEG END OFFSET PARENT PHASE]
 
 
 Processing a synchronization request consists of three phases:
 Processing a synchronization request consists of three phases:
 
 
@@ -4699,7 +4699,7 @@ Processing a synchronization request consists of three phases:
 During phase 0, NEXT is the key of the first element to be
 During phase 0, NEXT is the key of the first element to be
 removed, BEG and END is buffer position delimiting the
 removed, BEG and END is buffer position delimiting the
 modifications.  Elements starting between them (inclusive) are
 modifications.  Elements starting between them (inclusive) are
-removed and so are those contained within OUTREACH.  PARENT, when
+removed.  So are elements whose parent is removed.  PARENT, when
 non-nil, is the parent of the first element to be removed.
 non-nil, is the parent of the first element to be removed.
 
 
 During phase 1, NEXT is the key of the next known element in
 During phase 1, NEXT is the key of the next known element in
@@ -5041,7 +5041,7 @@ updated before current modification are actually submitted."
 	  (clrhash org-element--cache-sync-keys))))))
 	  (clrhash org-element--cache-sync-keys))))))
 
 
 (defun org-element--cache-process-request
 (defun org-element--cache-process-request
-  (request next threshold time-limit future-change)
+    (request next threshold time-limit future-change)
   "Process synchronization REQUEST for all entries before NEXT.
   "Process synchronization REQUEST for all entries before NEXT.
 
 
 REQUEST is a vector, built by `org-element--cache-submit-request'.
 REQUEST is a vector, built by `org-element--cache-submit-request'.
@@ -5061,54 +5061,61 @@ not registered yet in the cache are going to happen.  See
 Throw `interrupt' if the process stops before completing the
 Throw `interrupt' if the process stops before completing the
 request."
 request."
   (catch 'quit
   (catch 'quit
-    (when (= (aref request 6) 0)
+    (when (= (aref request 5) 0)
       ;; Phase 0.
       ;; Phase 0.
       ;;
       ;;
       ;; Delete all elements starting after BEG, but not after buffer
       ;; Delete all elements starting after BEG, but not after buffer
-      ;; position END or past element with key NEXT.
+      ;; position END or past element with key NEXT.  Also delete
+      ;; elements contained within a previously removed element
+      ;; (stored in `last-container').
       ;;
       ;;
       ;; At each iteration, we start again at tree root since
       ;; At each iteration, we start again at tree root since
       ;; a deletion modifies structure of the balanced tree.
       ;; a deletion modifies structure of the balanced tree.
       (catch 'end-phase
       (catch 'end-phase
-        (let ((beg (aref request 0))
-              (end (aref request 2))
-	      (outreach (aref request 4)))
-          (while t
-            (when (org-element--cache-interrupt-p time-limit)
-	      (throw 'interrupt nil))
-            ;; Find first element in cache with key BEG or after it.
-            (let ((node (org-element--cache-root)) data data-key)
-              (while node
-                (let* ((element (avl-tree--node-data node))
-                       (key (org-element--cache-key element)))
-                  (cond
-                   ((org-element--cache-key-less-p key beg)
-                    (setq node (avl-tree--node-right node)))
-                   ((org-element--cache-key-less-p beg key)
-                    (setq data element
-                          data-key key
-                          node (avl-tree--node-left node)))
-                   (t (setq data element
-                            data-key key
-                            node nil)))))
-	      (if data
-		  (let ((pos (org-element-property :begin data)))
-		    (if (if (or (not next)
-				(org-element--cache-key-less-p data-key next))
-			    (<= pos end)
-			  (let ((up data))
-			    (while (and up (not (eq up outreach)))
-			      (setq up (org-element-property :parent up)))
-			    up))
-			(org-element--cache-remove data)
-		      (aset request 0 data-key)
-		      (aset request 1 pos)
-		      (aset request 6 1)
-		      (throw 'end-phase nil)))
-		;; No element starting after modifications left in
-		;; cache: further processing is futile.
-		(throw 'quit t)))))))
-    (when (= (aref request 6) 1)
+        (while t
+	  (when (org-element--cache-interrupt-p time-limit)
+	    (throw 'interrupt nil))
+	  ;; Find first element in cache with key BEG or after it.
+	  (let ((beg (aref request 0))
+		(end (aref request 2))
+		(node (org-element--cache-root))
+		data data-key last-container)
+	    (while node
+	      (let* ((element (avl-tree--node-data node))
+		     (key (org-element--cache-key element)))
+		(cond
+		 ((org-element--cache-key-less-p key beg)
+		  (setq node (avl-tree--node-right node)))
+		 ((org-element--cache-key-less-p beg key)
+		  (setq data element
+			data-key key
+			node (avl-tree--node-left node)))
+		 (t (setq data element
+			  data-key key
+			  node nil)))))
+	    (if data
+		(let ((pos (org-element-property :begin data)))
+		  (if (if (or (not next)
+			      (org-element--cache-key-less-p data-key next))
+			  (<= pos end)
+			(and last-container
+			     (let ((up data))
+			       (while (and up (not (eq up last-container)))
+				 (setq up (org-element-property :parent up)))
+			       up)))
+		      (progn (when (and (not last-container)
+					(> (org-element-property :end data)
+					   end))
+			       (setq last-container data))
+			     (org-element--cache-remove data))
+		    (aset request 0 data-key)
+		    (aset request 1 pos)
+		    (aset request 5 1)
+		    (throw 'end-phase nil)))
+	      ;; No element starting after modifications left in
+	      ;; cache: further processing is futile.
+	      (throw 'quit t))))))
+    (when (= (aref request 5) 1)
       ;; Phase 1.
       ;; Phase 1.
       ;;
       ;;
       ;; Phase 0 left a hole in the cache.  Some elements after it
       ;; Phase 0 left a hole in the cache.  Some elements after it
@@ -5142,7 +5149,7 @@ request."
 	  (let ((next-request (nth 1 org-element--cache-sync-requests)))
 	  (let ((next-request (nth 1 org-element--cache-sync-requests)))
 	    (aset next-request 0 key)
 	    (aset next-request 0 key)
 	    (aset next-request 1 (aref request 1))
 	    (aset next-request 1 (aref request 1))
-	    (aset next-request 6 1))
+	    (aset next-request 5 1))
 	  (throw 'quit t)))
 	  (throw 'quit t)))
       ;; Next element will start at its beginning position plus
       ;; Next element will start at its beginning position plus
       ;; offset, since it hasn't been shifted yet.  Therefore, LIMIT
       ;; offset, since it hasn't been shifted yet.  Therefore, LIMIT
@@ -5154,11 +5161,11 @@ request."
 	       ;; Changes are going to happen around this element and
 	       ;; Changes are going to happen around this element and
 	       ;; they will trigger another phase 1 request.  Skip the
 	       ;; they will trigger another phase 1 request.  Skip the
 	       ;; current one.
 	       ;; current one.
-	       (aset request 6 2))
+	       (aset request 5 2))
 	      (t
 	      (t
 	       (let ((parent (org-element--parse-to limit t time-limit)))
 	       (let ((parent (org-element--parse-to limit t time-limit)))
-		 (aset request 5 parent)
-		 (aset request 6 2))))))
+		 (aset request 4 parent)
+		 (aset request 5 2))))))
     ;; Phase 2.
     ;; Phase 2.
     ;;
     ;;
     ;; Shift all elements starting from key START, but before NEXT, by
     ;; Shift all elements starting from key START, but before NEXT, by
@@ -5172,7 +5179,7 @@ request."
     ;; request is updated.
     ;; request is updated.
     (let ((start (aref request 0))
     (let ((start (aref request 0))
 	  (offset (aref request 3))
 	  (offset (aref request 3))
-	  (parent (aref request 5))
+	  (parent (aref request 4))
 	  (node (org-element--cache-root))
 	  (node (org-element--cache-root))
 	  (stack (list nil))
 	  (stack (list nil))
 	  (leftp t)
 	  (leftp t)
@@ -5192,7 +5199,7 @@ request."
 	      ;; Handle interruption request.  Update current request.
 	      ;; Handle interruption request.  Update current request.
 	      (when (or exit-flag (org-element--cache-interrupt-p time-limit))
 	      (when (or exit-flag (org-element--cache-interrupt-p time-limit))
 		(aset request 0 key)
 		(aset request 0 key)
-		(aset request 5 parent)
+		(aset request 4 parent)
 		(throw 'interrupt nil))
 		(throw 'interrupt nil))
 	      ;; Shift element.
 	      ;; Shift element.
 	      (unless (zerop offset)
 	      (unless (zerop offset)
@@ -5493,7 +5500,7 @@ change, as an integer."
   (let ((next (car org-element--cache-sync-requests))
   (let ((next (car org-element--cache-sync-requests))
 	delete-to delete-from)
 	delete-to delete-from)
     (if (and next
     (if (and next
-	     (zerop (aref next 6))
+	     (zerop (aref next 5))
 	     (> (setq delete-to (+ (aref next 2) (aref next 3))) end)
 	     (> (setq delete-to (+ (aref next 2) (aref next 3))) end)
 	     (<= (setq delete-from (aref next 1)) end))
 	     (<= (setq delete-from (aref next 1)) end))
 	;; Current changes can be merged with first sync request: we
 	;; Current changes can be merged with first sync request: we
@@ -5504,7 +5511,7 @@ change, as an integer."
 	  ;; boundaries of robust parents, if any.  Otherwise, find
 	  ;; boundaries of robust parents, if any.  Otherwise, find
 	  ;; first element to remove and update request accordingly.
 	  ;; first element to remove and update request accordingly.
 	  (if (> beg delete-from)
 	  (if (> beg delete-from)
-	      (let ((up (aref next 5)))
+	      (let ((up (aref next 4)))
 		(while up
 		(while up
 		  (org-element--cache-shift-positions
 		  (org-element--cache-shift-positions
 		   up offset '(:contents-end :end))
 		   up offset '(:contents-end :end))
@@ -5513,7 +5520,7 @@ change, as an integer."
 	      (when first
 	      (when first
 		(aset next 0 (org-element--cache-key first))
 		(aset next 0 (org-element--cache-key first))
 		(aset next 1 (org-element-property :begin first))
 		(aset next 1 (org-element-property :begin first))
-		(aset next 5 (org-element-property :parent first))))))
+		(aset next 4 (org-element-property :parent first))))))
       ;; Ensure cache is correct up to END.  Also make sure that NEXT,
       ;; Ensure cache is correct up to END.  Also make sure that NEXT,
       ;; if any, is no longer a 0-phase request, thus ensuring that
       ;; if any, is no longer a 0-phase request, thus ensuring that
       ;; phases are properly ordered.  We need to provide OFFSET as
       ;; phases are properly ordered.  We need to provide OFFSET as
@@ -5529,21 +5536,13 @@ change, as an integer."
 		     ;; When changes happen before the first known
 		     ;; When changes happen before the first known
 		     ;; element, re-parent and shift the rest of the
 		     ;; element, re-parent and shift the rest of the
 		     ;; cache.
 		     ;; cache.
-		     ((> beg end) (vector key beg nil offset nil nil 1))
+		     ((> beg end) (vector key beg nil offset nil 1))
 		     ;; Otherwise, we find the first non robust
 		     ;; Otherwise, we find the first non robust
 		     ;; element containing END.  All elements between
 		     ;; element containing END.  All elements between
 		     ;; FIRST and this one are to be removed.
 		     ;; FIRST and this one are to be removed.
-		     ;;
-		     ;; Among them, some could be located outside the
-		     ;; synchronized part of the cache, in which case
-		     ;; comparing buffer positions to find them is
-		     ;; useless.  Instead, we store the element
-		     ;; containing them in the request itself.  All
-		     ;; its children will be removed.
 		     ((let ((first-end (org-element-property :end first)))
 		     ((let ((first-end (org-element-property :end first)))
 			(and (> first-end end)
 			(and (> first-end end)
-			     (vector key beg first-end offset first
-				     (org-element-property :parent first) 0))))
+			     (vector key beg first-end offset first 0))))
 		     (t
 		     (t
 		      (let* ((element (org-element--cache-find end))
 		      (let* ((element (org-element--cache-find end))
 			     (end (org-element-property :end element))
 			     (end (org-element-property :end element))
@@ -5552,8 +5551,7 @@ change, as an integer."
 				    (>= (org-element-property :begin up) beg))
 				    (>= (org-element-property :begin up) beg))
 			  (setq end (org-element-property :end up)
 			  (setq end (org-element-property :end up)
 				element up))
 				element up))
-			(vector key beg end offset element
-				(org-element-property :parent first) 0)))))
+			(vector key beg end offset element 0)))))
 		  org-element--cache-sync-requests)
 		  org-element--cache-sync-requests)
 	  ;; No element to remove.  No need to re-parent either.
 	  ;; No element to remove.  No need to re-parent either.
 	  ;; Simply shift additional elements, if any, by OFFSET.
 	  ;; Simply shift additional elements, if any, by OFFSET.

+ 15 - 1
testing/lisp/test-org-element.el

@@ -3586,7 +3586,21 @@ Text
 	 (let ((org-element-use-cache t))
 	 (let ((org-element-use-cache t))
 	   (org-element-at-point)
 	   (org-element-at-point)
 	   (insert "+:")
 	   (insert "+:")
-	   (org-element-type (org-element-at-point)))))))
+	   (org-element-type (org-element-at-point))))))
+  ;; Properly handle elements not altered by modifications but whose
+  ;; parents were removed from cache.
+  (should
+   (org-test-with-temp-text
+       "Paragraph\n\n\n\n#+begin_center\n<point>contents\n#+end_center"
+     (let ((org-element-use-cache t)
+	   (parent-end (point-max)))
+       (org-element-at-point)
+       (save-excursion (search-backward "Paragraph")
+		       (forward-line 2)
+		       (insert "\n  "))
+       (eq (org-element-property
+	    :end (org-element-property :parent (org-element-at-point)))
+	   (+ parent-end 3))))))
 
 
 
 
 (provide 'test-org-element)
 (provide 'test-org-element)