Prechádzať zdrojové kódy

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 rokov pred
rodič
commit
af1bd190e3
1 zmenil súbory, kde vykonal 110 pridanie a 107 odobranie
  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
 	 headline :title
 	 (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)
   "Interpret HEADLINE element as Org syntax.
@@ -1126,17 +1125,16 @@ Assume point is at beginning of the inline task."
       (org-element-put-property
        inlinetask :title
        (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)
   "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)))
 	 (when 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)
   "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)))))
 	  (insert string)
 	  (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
     (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))))
 
 (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.
 
 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 (and (eq granularity 'headline) (not (org-at-heading-p)))
       (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)
   "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))
 	       (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.
 
-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-restriction
       (narrow-to-region beg end)
       (goto-char (point-min))
-      (let (next-object)
+      (let ((tab (make-string tab-width ?\s))
+	    next-object contents)
 	(while (and (not (eobp))
 		    (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)))
 	    (unless (= (point) obj-beg)
-	      (setq acc
-		    (org-element-adopt-elements
-		     acc
+	      (let ((text
 		     (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))
 		(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))))))))