Browse Source

org-element: Refactor object parsing

* lisp/org-element.el (org-element--get-next-object-candidates):
  Rewrite function to simplify algorithm.
(org-element-context, (org-element--parse-elements)): Apply
changes.
* lisp/org.el (org-fill-paragraph): Apply changes.
Nicolas Goaziou 12 years ago
parent
commit
e024beaa7e
2 changed files with 36 additions and 44 deletions
  1. 34 42
      lisp/org-element.el
  2. 2 2
      lisp/org.el

+ 34 - 42
lisp/org-element.el

@@ -4255,9 +4255,9 @@ Elements are accumulated into ACC."
 
 
 Objects are accumulated in ACC.
 Objects are accumulated in ACC.
 
 
-RESTRICTION is a list of object types which are allowed in the
-current object."
-  (let (candidates)
+RESTRICTION is a list of object successors which are allowed in
+the current object."
+  (let ((candidates 'initial))
     (save-excursion
     (save-excursion
       (goto-char beg)
       (goto-char beg)
       (while (and (< (point) end)
       (while (and (< (point) end)
@@ -4309,44 +4309,35 @@ current object."
   "Return an alist of candidates for the next object.
   "Return an alist of candidates for the next object.
 
 
 LIMIT bounds the search, and RESTRICTION narrows candidates to
 LIMIT bounds the search, and RESTRICTION narrows candidates to
-some object types.
-
-Return value is an alist whose CAR is position and CDR the object
-type, as a symbol.
-
-OBJECTS is the previous candidates alist."
-  ;; Filter out any object found but not belonging to RESTRICTION.
-  (setq objects
-	(org-remove-if-not
-	 (lambda (obj)
-	   (let ((type (car obj)))
-	     (memq (or (cdr (assq type org-element-object-successor-alist))
-		       type)
-		   restriction)))
-	 objects))
-  (let (next-candidates types-to-search)
-    ;; If no previous result, search every object type in RESTRICTION.
-    ;; Otherwise, keep potential candidates (old objects located after
-    ;; point) and ask to search again those which had matched before.
-    (if (not objects) (setq types-to-search restriction)
-      (mapc (lambda (obj)
-	      (if (< (cdr obj) (point)) (push (car obj) types-to-search)
-		(push obj next-candidates)))
-	    objects))
-    ;; Call the appropriate successor function for each type to search
-    ;; and accumulate matches.
-    (mapc
-     (lambda (type)
-       (let* ((successor-fun
-	       (intern
-		(format "org-element-%s-successor"
-			(or (cdr (assq type org-element-object-successor-alist))
-			    type))))
-	      (obj (funcall successor-fun limit)))
-	 (and obj (push obj next-candidates))))
-     types-to-search)
-    ;; Return alist.
-    next-candidates))
+some object successors.
+
+OBJECTS is the previous candidates alist.  If it is set to
+`initial', no search has been done before, and all symbols in
+RESTRICTION should be looked after.
+
+Return value is an alist whose CAR is the object type and CDR its
+beginning position."
+  (delq
+   nil
+   (if (eq objects 'initial)
+       ;; When searching for the first time, look for every successor
+       ;; allowed in RESTRICTION.
+       (mapcar
+	(lambda (res)
+	  (funcall (intern (format "org-element-%s-successor" res)) limit))
+	restriction)
+     ;; Focus on objects returned during last search.  Keep those
+     ;; still after point.  Search again objects before it.
+     (mapcar
+      (lambda (obj)
+	(if (>= (cdr obj) (point)) obj
+	  (let* ((type (car obj))
+		 (succ (or (cdr (assq type org-element-object-successor-alist))
+			   type)))
+	    (and succ
+		 (funcall (intern (format "org-element-%s-successor" succ))
+			  limit)))))
+      objects))))
 
 
 
 
 
 
@@ -4776,7 +4767,7 @@ Providing it allows for quicker computation."
 	 element
 	 element
        (let ((restriction (org-element-restriction type))
        (let ((restriction (org-element-restriction type))
 	     (parent element)
 	     (parent element)
-	     candidates)
+	     (candidates 'initial))
 	 (catch 'exit
 	 (catch 'exit
 	   (while (setq candidates (org-element--get-next-object-candidates
 	   (while (setq candidates (org-element--get-next-object-candidates
 				    end restriction candidates))
 				    end restriction candidates))
@@ -4810,6 +4801,7 @@ Providing it allows for quicker computation."
 		       (org-element-put-property object :parent parent)
 		       (org-element-put-property object :parent parent)
 		       (setq parent object
 		       (setq parent object
 			     restriction (org-element-restriction object)
 			     restriction (org-element-restriction object)
+			     candidates 'initial
 			     end cend)))))))
 			     end cend)))))))
 	   parent))))))
 	   parent))))))
 
 

+ 2 - 2
lisp/org.el

@@ -21741,7 +21741,7 @@ meant to be filled."
 
 
 (declare-function message-goto-body "message" ())
 (declare-function message-goto-body "message" ())
 (defvar message-cite-prefix-regexp)	; From message.el
 (defvar message-cite-prefix-regexp)	; From message.el
-(defvar org-element-all-objects)	; From org-element.el
+(defvar org-element-all-successors)	; From org-element.el
 (defun org-fill-paragraph (&optional justify)
 (defun org-fill-paragraph (&optional justify)
   "Fill element at point, when applicable.
   "Fill element at point, when applicable.
 
 
@@ -21819,7 +21819,7 @@ a footnote definition, try to fill the first paragraph within."
 		   (cons beg
 		   (cons beg
 			 (org-element-map
 			 (org-element-map
 			     (org-element--parse-objects
 			     (org-element--parse-objects
-			      beg end nil org-element-all-objects)
+			      beg end nil org-element-all-successors)
 			     'line-break
 			     'line-break
 			   (lambda (lb) (org-element-property :end lb)))))))
 			   (lambda (lb) (org-element-property :end lb)))))))
 	       t)))
 	       t)))