org-element--parse-to: Micro optimizations

* lisp/org-element.el (org-element-headline-parser): Store :true-level
property.
(org-element--parse-to): Call `org-get-limited-outline-regexp'
directly rather than via `org-with-limited-levels'.  Avoid moving
point unnecessarily.  Prefer `org-headline-re' to generate regexps.
* lisp/org-macs.el (org-headline-re):
(org-skip-whitespace): Inline.
This commit is contained in:
Ihor Radchenko 2023-05-15 14:56:35 +02:00
parent 64e15ea0b0
commit 6d9f3af774
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
2 changed files with 15 additions and 19 deletions

View File

@ -1188,6 +1188,7 @@ Assume point is at beginning of the headline."
:contents-end contents-end
:robust-begin robust-begin
:robust-end robust-end
:true-level true-level
:level level
:priority priority
:tags tags
@ -6472,7 +6473,10 @@ the expected result."
;; buffer above. This comes at the cost of not calculating
;; `:parent' property for headings.
((not cached)
(if (org-with-limited-levels (outline-previous-heading))
(end-of-line) ; ensure the end of current heading.
(if (re-search-backward
(org-get-limited-outline-regexp t)
nil 'move)
(progn
(setq element (org-element-headline-parser nil 'fast))
(setq mode 'planning)
@ -6502,11 +6506,11 @@ the expected result."
(let ((up cached)
(pos (if (= (point-max) pos) (1- pos) pos)))
(while (and up (<= (org-element-property :end up) pos))
(goto-char (org-element-property :end up))
(setq element up
(setq next (org-element-property :end up)
element up
mode (org-element--next-mode (org-element-property :mode element) (org-element-type element) nil)
up (org-element-property :parent up)
next (point)))
up (org-element-property :parent up)))
(when next (goto-char next))
(when up (setq element up)))))
;; Parse successively each element until we reach POS.
(let ((end (or (org-element-property :end element) (point-max)))
@ -6543,7 +6547,7 @@ If you observe Emacs hangs frequently, please report this to Org mode mailing li
(setq element (or (org-element--cache-put element) element))
;; Nothing to parse (i.e. empty file).
(throw 'exit parent))
(unless (or (not (org-element--cache-active-p)) parent)
(unless (or parent (not (org-element--cache-active-p)))
(org-element--cache-warn
"Got empty parent while parsing. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n Backtrace:\n%S"
(when (and (fboundp 'backtrace-get-frames)
@ -6564,13 +6568,9 @@ If you observe Emacs hangs frequently, please report this to Org mode mailing li
(goto-char elem-end)
(when (eq type 'headline)
(save-match-data
(unless (when (and (/= 1 (org-element-property :level element))
(unless (when (and (/= 1 (org-element-property :true-level element))
(re-search-forward
(rx-to-string
`(and bol (repeat 1 ,(1- (let ((level (org-element-property :level element)))
(if org-odd-levels-only (1- (* level 2)) level)))
"*")
" "))
(org-headline-re (1- (org-element-property :true-level element)))
pos t))
(beginning-of-line)
t)
@ -6582,11 +6582,7 @@ If you observe Emacs hangs frequently, please report this to Org mode mailing li
(goto-char pos)
(unless
(re-search-backward
(rx-to-string
`(and bol (repeat ,(let ((level (org-element-property :level element)))
(if org-odd-levels-only (1- (* level 2)) level))
"*")
" "))
(org-headline-re (org-element-property :true-level element))
elem-end t)
;; Roll-back to normal parsing.
(goto-char elem-end)))))

View File

@ -811,7 +811,7 @@ get an unnecessary O(N²) space complexity, so you're usually better off using
"Plist holding association between headline level regexp.")
(defvar org--headline-re-cache-bol nil
"Plist holding association between headline level regexp.")
(defun org-headline-re (true-level &optional no-bol)
(defsubst org-headline-re (true-level &optional no-bol)
"Generate headline regexp for TRUE-LEVEL.
When NO-BOL is non-nil, regexp will not demand the regexp to start at
beginning of line."
@ -964,7 +964,7 @@ Return nil when PROP is not set at POS."
(<= (match-beginning n) pos)
(>= (match-end n) pos)))
(defun org-skip-whitespace ()
(defsubst org-skip-whitespace ()
"Skip over space, tabs and newline characters."
(skip-chars-forward " \t\n\r"))