Browse Source

org-element: Small speed-up

* lisp/org-element.el (org-element--parse-objects): Add an optional
  argument to avoid walking a secondary string twice.  Make less
  consing.
(org-element--parse-elements): Make less consing.
(org-element-headline-parser):
(org-element-inlinetask-parser):
(org-element-item-parser):
(org-element-parse-secondary-string): Apply changes.
Nicolas Goaziou 9 years ago
parent
commit
af1bd190e3
1 changed files with 110 additions and 107 deletions
  1. 110 107
      lisp/org-element.el

+ 110 - 107
lisp/org-element.el

@@ -990,17 +990,16 @@ Assume point is at beginning of the headline."
 	(org-element-put-property
 	(org-element-put-property
 	 headline :title
 	 headline :title
 	 (if raw-secondary-p raw-value
 	 (if raw-secondary-p raw-value
-	   (let ((title (org-element--parse-objects
-			 (progn (goto-char title-start)
-				(skip-chars-forward " \t")
-				(point))
-			 (progn (goto-char title-end)
-				(skip-chars-backward " \t")
-				(point))
-			 nil
-			 (org-element-restriction 'headline))))
-	     (dolist (datum title title)
-	       (org-element-put-property datum :parent headline)))))))))
+	   (org-element--parse-objects
+	    (progn (goto-char title-start)
+		   (skip-chars-forward " \t")
+		   (point))
+	    (progn (goto-char title-end)
+		   (skip-chars-backward " \t")
+		   (point))
+	    nil
+	    (org-element-restriction 'headline)
+	    headline)))))))
 
 
 (defun org-element-headline-interpreter (headline contents)
 (defun org-element-headline-interpreter (headline contents)
   "Interpret HEADLINE element as Org syntax.
   "Interpret HEADLINE element as Org syntax.
@@ -1126,17 +1125,16 @@ Assume point is at beginning of the inline task."
       (org-element-put-property
       (org-element-put-property
        inlinetask :title
        inlinetask :title
        (if raw-secondary-p raw-value
        (if raw-secondary-p raw-value
-	 (let ((title (org-element--parse-objects
-		       (progn (goto-char title-start)
-			      (skip-chars-forward " \t")
-			      (point))
-		       (progn (goto-char title-end)
-			      (skip-chars-backward " \t")
-			      (point))
-		       nil
-		       (org-element-restriction 'inlinetask))))
-	   (dolist (datum title title)
-	     (org-element-put-property datum :parent inlinetask))))))))
+	 (org-element--parse-objects
+	  (progn (goto-char title-start)
+		 (skip-chars-forward " \t")
+		 (point))
+	  (progn (goto-char title-end)
+		 (skip-chars-backward " \t")
+		 (point))
+	  nil
+	  (org-element-restriction 'inlinetask)
+	  inlinetask))))))
 
 
 (defun org-element-inlinetask-interpreter (inlinetask contents)
 (defun org-element-inlinetask-interpreter (inlinetask contents)
   "Interpret INLINETASK element as Org syntax.
   "Interpret INLINETASK element as Org syntax.
@@ -1248,11 +1246,10 @@ Assume point is at the beginning of the item."
        (let ((raw (org-list-get-tag begin struct)))
        (let ((raw (org-list-get-tag begin struct)))
 	 (when raw
 	 (when raw
 	   (if raw-secondary-p raw
 	   (if raw-secondary-p raw
-	     (let ((tag (org-element--parse-objects
-			 (match-beginning 4) (match-end 4) nil
-			 (org-element-restriction 'item))))
-	       (dolist (datum tag tag)
-		 (org-element-put-property datum :parent item))))))))))
+	     (org-element--parse-objects
+	      (match-beginning 4) (match-end 4) nil
+	      (org-element-restriction 'item)
+	      item))))))))
 
 
 (defun org-element-item-interpreter (item contents)
 (defun org-element-item-interpreter (item contents)
   "Interpret ITEM element as Org syntax.
   "Interpret ITEM element as Org syntax.
@@ -3979,11 +3976,8 @@ If STRING is the empty string or nil, return nil."
 		(set (make-local-variable (car v)) (cdr v)))))
 		(set (make-local-variable (car v)) (cdr v)))))
 	  (insert string)
 	  (insert string)
 	  (restore-buffer-modified-p nil)
 	  (restore-buffer-modified-p nil)
-	  (let ((data (org-element--parse-objects
-		       (point-min) (point-max) nil restriction)))
-	    (when parent
-	      (dolist (o data) (org-element-put-property o :parent parent)))
-	    data))))))
+	  (org-element--parse-objects
+	   (point-min) (point-max) nil restriction parent))))))
 
 
 (defun org-element-map
 (defun org-element-map
     (data types fun &optional info first-match no-recursion with-affiliated)
     (data types fun &optional info first-match no-recursion with-affiliated)
@@ -4174,7 +4168,7 @@ otherwise.  Modes can be either `first-section', `item',
       (`table-row 'table-row))))
       (`table-row 'table-row))))
 
 
 (defun org-element--parse-elements
 (defun org-element--parse-elements
-  (beg end mode structure granularity visible-only acc)
+    (beg end mode structure granularity visible-only acc)
   "Parse elements between BEG and END positions.
   "Parse elements between BEG and END positions.
 
 
 MODE prioritizes some elements over the others.  It can be set to
 MODE prioritizes some elements over the others.  It can be set to
@@ -4200,49 +4194,49 @@ Elements are accumulated into ACC."
     ;; When parsing only headlines, skip any text before first one.
     ;; When parsing only headlines, skip any text before first one.
     (when (and (eq granularity 'headline) (not (org-at-heading-p)))
     (when (and (eq granularity 'headline) (not (org-at-heading-p)))
       (org-with-limited-levels (outline-next-heading)))
       (org-with-limited-levels (outline-next-heading)))
-    ;; Main loop start.
-    (while (< (point) end)
-      ;; Find current element's type and parse it accordingly to
-      ;; its category.
-      (let* ((element (org-element--current-element
-		       end granularity mode structure))
-	     (type (org-element-type element))
-	     (cbeg (org-element-property :contents-begin element)))
-	(goto-char (org-element-property :end element))
-	;; Visible only: skip invisible parts between siblings.
-	(when (and visible-only (org-invisible-p2))
-	  (goto-char (min (1+ (org-find-visible)) end)))
-	;; Fill ELEMENT contents by side-effect.
-	(cond
-	 ;; If element has no contents, don't modify it.
-	 ((not cbeg))
-	 ;; Greater element: parse it between `contents-begin' and
-	 ;; `contents-end'.  Make sure GRANULARITY allows the
-	 ;; recursion, or ELEMENT is a headline, in which case going
-	 ;; inside is mandatory, in order to get sub-level headings.
-	 ((and (memq type org-element-greater-elements)
-	       (or (memq granularity '(element object nil))
-		   (and (eq granularity 'greater-element)
-			(eq type 'section))
-		   (eq type 'headline)))
-	  (org-element--parse-elements
-	   cbeg (org-element-property :contents-end element)
-	   ;; Possibly switch to a special mode.
-	   (org-element--next-mode type t)
-	   (and (memq type '(item plain-list))
-		(org-element-property :structure element))
-	   granularity visible-only element))
-	 ;; ELEMENT has contents.  Parse objects inside, if
-	 ;; GRANULARITY allows it.
-	 ((memq granularity '(object nil))
-	  (org-element--parse-objects
-	   cbeg (org-element-property :contents-end element) element
-	   (org-element-restriction type))))
-	(org-element-adopt-elements acc element)
-	;; Update mode.
-	(setq mode (org-element--next-mode type nil))))
-    ;; Return result.
-    acc))
+    (let (elements)
+      (while (< (point) end)
+	;; Find current element's type and parse it accordingly to
+	;; its category.
+	(let* ((element (org-element--current-element
+			 end granularity mode structure))
+	       (type (org-element-type element))
+	       (cbeg (org-element-property :contents-begin element)))
+	  (goto-char (org-element-property :end element))
+	  ;; Visible only: skip invisible parts between siblings.
+	  (when (and visible-only (org-invisible-p2))
+	    (goto-char (min (1+ (org-find-visible)) end)))
+	  ;; Fill ELEMENT contents by side-effect.
+	  (cond
+	   ;; If element has no contents, don't modify it.
+	   ((not cbeg))
+	   ;; Greater element: parse it between `contents-begin' and
+	   ;; `contents-end'.  Make sure GRANULARITY allows the
+	   ;; recursion, or ELEMENT is a headline, in which case going
+	   ;; inside is mandatory, in order to get sub-level headings.
+	   ((and (memq type org-element-greater-elements)
+		 (or (memq granularity '(element object nil))
+		     (and (eq granularity 'greater-element)
+			  (eq type 'section))
+		     (eq type 'headline)))
+	    (org-element--parse-elements
+	     cbeg (org-element-property :contents-end element)
+	     ;; Possibly switch to a special mode.
+	     (org-element--next-mode type t)
+	     (and (memq type '(item plain-list))
+		  (org-element-property :structure element))
+	     granularity visible-only element))
+	   ;; ELEMENT has contents.  Parse objects inside, if
+	   ;; GRANULARITY allows it.
+	   ((memq granularity '(object nil))
+	    (org-element--parse-objects
+	     cbeg (org-element-property :contents-end element) element
+	     (org-element-restriction type))))
+	  (push (org-element-put-property element :parent acc) elements)
+	  ;; Update mode.
+	  (setq mode (org-element--next-mode type nil))))
+      ;; Return result.
+      (apply #'org-element-set-contents acc (nreverse elements)))))
 
 
 (defun org-element--object-lex (restriction)
 (defun org-element--object-lex (restriction)
   "Return next object in current buffer or nil.
   "Return next object in current buffer or nil.
@@ -4331,51 +4325,60 @@ to an appropriate container (e.g., a paragraph)."
 	      ((and limit (memq 'link restriction))
 	      ((and limit (memq 'link restriction))
 	       (goto-char limit) (org-element-link-parser)))))))
 	       (goto-char limit) (org-element-link-parser)))))))
 
 
-(defun org-element--parse-objects (beg end acc restriction)
+(defun org-element--parse-objects (beg end acc restriction &optional parent)
   "Parse objects between BEG and END and return recursive structure.
   "Parse objects between BEG and END and return recursive structure.
 
 
-Objects are accumulated in ACC.
+Objects are accumulated in ACC.  RESTRICTION is a list of object
+successors which are allowed in the current object.
 
 
-RESTRICTION is a list of object successors which are allowed in
-the current object."
+ACC becomes the parent for all parsed objects.  However, if ACC
+is nil (i.e., a secondary string is being parsed) and optional
+argument PARENT is non-nil, use it as the parent for all objects.
+Eventually, if both ACC and PARENT are nil, the common parent is
+the list of objects itself."
   (save-excursion
   (save-excursion
     (save-restriction
     (save-restriction
       (narrow-to-region beg end)
       (narrow-to-region beg end)
       (goto-char (point-min))
       (goto-char (point-min))
-      (let (next-object)
+      (let ((tab (make-string tab-width ?\s))
+	    next-object contents)
 	(while (and (not (eobp))
 	(while (and (not (eobp))
 		    (setq next-object (org-element--object-lex restriction)))
 		    (setq next-object (org-element--object-lex restriction)))
-	  ;; 1. Text before any object.  Untabify it.
+	  ;; Text before any object.  Untabify it.
 	  (let ((obj-beg (org-element-property :begin next-object)))
 	  (let ((obj-beg (org-element-property :begin next-object)))
 	    (unless (= (point) obj-beg)
 	    (unless (= (point) obj-beg)
-	      (setq acc
-		    (org-element-adopt-elements
-		     acc
+	      (let ((text
 		     (replace-regexp-in-string
 		     (replace-regexp-in-string
-		      "\t" (make-string tab-width ?\s)
-		      (buffer-substring-no-properties (point) obj-beg))))))
-	  ;; 2. Object...
+		      "\t" tab
+		      (buffer-substring-no-properties (point) obj-beg))))
+		(push (if acc (org-element-put-property text :parent acc) text)
+		      contents))))
+	  ;; Object...
 	  (let ((obj-end (org-element-property :end next-object))
 	  (let ((obj-end (org-element-property :end next-object))
 		(cont-beg (org-element-property :contents-begin next-object)))
 		(cont-beg (org-element-property :contents-begin next-object)))
-	    ;; Fill contents of NEXT-OBJECT by side-effect, if it has
-	    ;; a recursive type.
-	    (when (and cont-beg
-		       (memq (car next-object) org-element-recursive-objects))
-	      (org-element--parse-objects
-	       cont-beg (org-element-property :contents-end next-object)
-	       next-object (org-element-restriction next-object)))
-	    (setq acc (org-element-adopt-elements acc next-object))
-	    (goto-char obj-end))))
-      ;; 3. Text after last object.  Untabify it.
-      (unless (eobp)
-	(setq acc
-	      (org-element-adopt-elements
-	       acc
-	       (replace-regexp-in-string
-		"\t" (make-string tab-width ?\s)
-		(buffer-substring-no-properties (point) end)))))
-      ;; Result.
-      acc)))
+	    (when acc (org-element-put-property next-object :parent acc))
+	    (push (if cont-beg
+		      ;; Fill contents of NEXT-OBJECT if possible.
+		      (org-element--parse-objects
+		       cont-beg
+		       (org-element-property :contents-end next-object)
+		       next-object
+		       (org-element-restriction next-object))
+		    next-object)
+		  contents)
+	    (goto-char obj-end)))
+	;; Text after last object.  Untabify it.
+	(unless (eobp)
+	  (let ((text (replace-regexp-in-string
+		       "\t" tab (buffer-substring-no-properties (point) end))))
+	    (push (if acc (org-element-put-property text :parent acc) text)
+		  contents)))
+	;; Result.  Set appropriate parent.
+	(if acc (apply #'org-element-set-contents acc (nreverse contents))
+	  (let* ((contents (nreverse contents))
+		 (parent (or parent contents)))
+	    (dolist (datum contents contents)
+	      (org-element-put-property datum :parent parent))))))))