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.
This commit is contained in:
Nicolas Goaziou
parent
188823e372
commit
af1bd190e3
|
|
@ -990,7 +990,7 @@ 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
|
||||
(org-element--parse-objects
|
||||
(progn (goto-char title-start)
|
||||
(skip-chars-forward " \t")
|
||||
(point))
|
||||
|
|
@ -998,9 +998,8 @@ Assume point is at beginning of the headline."
|
|||
(skip-chars-backward " \t")
|
||||
(point))
|
||||
nil
|
||||
(org-element-restriction 'headline))))
|
||||
(dolist (datum title title)
|
||||
(org-element-put-property datum :parent headline)))))))))
|
||||
(org-element-restriction 'headline)
|
||||
headline)))))))
|
||||
|
||||
(defun org-element-headline-interpreter (headline contents)
|
||||
"Interpret HEADLINE element as Org syntax.
|
||||
|
|
@ -1126,7 +1125,7 @@ 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
|
||||
(org-element--parse-objects
|
||||
(progn (goto-char title-start)
|
||||
(skip-chars-forward " \t")
|
||||
(point))
|
||||
|
|
@ -1134,9 +1133,8 @@ Assume point is at beginning of the inline task."
|
|||
(skip-chars-backward " \t")
|
||||
(point))
|
||||
nil
|
||||
(org-element-restriction 'inlinetask))))
|
||||
(dolist (datum title title)
|
||||
(org-element-put-property datum :parent inlinetask))))))))
|
||||
(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
|
||||
(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-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)
|
||||
|
|
@ -4200,7 +4194,7 @@ 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.
|
||||
(let (elements)
|
||||
(while (< (point) end)
|
||||
;; Find current element's type and parse it accordingly to
|
||||
;; its category.
|
||||
|
|
@ -4238,11 +4232,11 @@ Elements are accumulated into ACC."
|
|||
(org-element--parse-objects
|
||||
cbeg (org-element-property :contents-end element) element
|
||||
(org-element-restriction type))))
|
||||
(org-element-adopt-elements acc element)
|
||||
(push (org-element-put-property element :parent acc) elements)
|
||||
;; Update mode.
|
||||
(setq mode (org-element--next-mode type nil))))
|
||||
;; Return result.
|
||||
acc))
|
||||
(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))
|
||||
(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)))
|
||||
(setq acc (org-element-adopt-elements acc next-object))
|
||||
(goto-char obj-end))))
|
||||
;; 3. Text after last object. Untabify it.
|
||||
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)
|
||||
(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)))
|
||||
(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))))))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue