ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

org-up-heading-safe: Use element API

This commit is contained in:
Ihor Radchenko 2023-05-05 14:48:11 +02:00
parent eb0a293a02
commit dfd36d1969
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 15 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
lisp/org.el
View File

@ -20576,55 +20576,26 @@ This function considers both visible and invisible heading lines.
With argument, move up ARG levels."
(outline-up-heading arg t))
(defvar-local org--up-heading-cache nil
"Buffer-local `org-up-heading-safe' cache.")
(defvar-local org--up-heading-cache-tick nil
"Buffer `buffer-chars-modified-tick' in `org--up-heading-cache'.")
(defun org-up-heading-safe ()
"Move to the heading line of which the present line is a subheading.
Return the heading level, as number or nil when there is no such heading.
When point is not at heading, go to the parent of the current heading.
When point is at or inside an inlinetask, go to the containing
heading.
This version will not throw an error. It will return the level of the
headline found, or nil if no higher level is found.
Also, this function will be a lot faster than `outline-up-heading',
because it relies on stars being the outline starters. This can really
make a significant difference in outlines with very many siblings."
(let ((element (and (org-element--cache-active-p)
(org-element-at-point nil t))))
(if element
(let* ((current-heading (org-element-lineage element '(headline inlinetask) 'with-self))
(parent (org-element-lineage current-heading 'headline)))
(if (and parent
(<= (point-min) (org-element-begin parent)))
(progn
(goto-char (org-element-begin parent))
(org-element-property :level parent))
(when (and current-heading
(<= (point-min) (org-element-begin current-heading)))
(goto-char (org-element-begin current-heading))
nil)))
(when (ignore-errors (org-back-to-heading t))
(let (level-cache)
(unless org--up-heading-cache
(setq org--up-heading-cache (make-hash-table)))
(if (and (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
(setq level-cache (gethash (point) org--up-heading-cache)))
(when (<= (point-min) (car level-cache) (point-max))
;; Parent is inside accessible part of the buffer.
(progn (goto-char (car level-cache))
(cdr level-cache)))
;; Buffer modified. Invalidate cache.
(unless (eq (buffer-chars-modified-tick) org--up-heading-cache-tick)
(setq-local org--up-heading-cache-tick
(buffer-chars-modified-tick))
(clrhash org--up-heading-cache))
(let* ((level-up (1- (funcall outline-level)))
(pos (point))
(result (and (> level-up 0)
(re-search-backward
(format "^\\*\\{1,%d\\} " level-up) nil t)
(funcall outline-level))))
(when result (puthash pos (cons (point) result) org--up-heading-cache))
result)))))))
When narrowing is in effect, ignore headings starting before the
available portion of the buffer."
(let ((heading (org-element-parent
(org-element-lineage
(org-element-at-point)
'(headline inlinetask) 'with-self))))
(when (and heading (<= (point-min) (org-element-begin heading)))
(goto-char (org-element-begin heading))
(org-element-property :level heading))))
(defun org-up-heading-or-point-min ()
"Move to the heading line of which the present is a subheading, or point-min.