forked from mirrors/org-mode
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,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))))))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue