org-up-heading-safe: Fix when parent is not a heading

* lisp/org.el (org-up-heading-safe): Do not assume that
`org-element-parent' is always a heading.  Use `org-element-lineage'
to get parent heading specifically.  Move point to current heading
even when no parent heading is available, as expected by some of the
other Org routines.  Document moving point when no parent.
* testing/lisp/test-org.el (test-org/up-heading-safe): Add tests.

Reported-by: Daniel Liden <djliden91@gmail.com>
Link: https://orgmode.org/list/CAG=u__pAT9k_AsRG6cpyPPUt0__5S7o=3a8WWkAijuPPuGc7Cg@mail.gmail.com
This commit is contained in:
Ihor Radchenko 2023-07-26 10:39:08 +03:00
parent 5f7cfdfd1d
commit dc78f09465
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
2 changed files with 67 additions and 7 deletions

View File

@ -20570,15 +20570,25 @@ 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.
When no higher level is found, the still move point to the containing
heading, if there is any in the accessible portion of the buffer.
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))))
(let* ((current-heading (org-element-lineage
(org-element-at-point)
'(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))))
(defun org-up-heading-or-point-min ()
"Move to the heading line of which the present is a subheading, or point-min.

View File

@ -2399,6 +2399,56 @@ Test
(org-back-to-heading)
(should (= 11 (point))))))
(ert-deftest test-org/up-heading-safe ()
"Test `org-up-heading-safe' specifications."
;; Jump to parent. Simple case.
(org-test-with-temp-text "
* H1
** H2<point>"
(should (= 1 (org-up-heading-safe)))
(should (looking-at-p "^\\* H1")))
;; Do not jump beyond the level 1 heading.
(org-test-with-temp-text "
Text.
* Heading <point>"
(let ((pos (point)))
(should-not (org-up-heading-safe))
(should (looking-at-p "^\\* Heading"))))
;; Jump from inside a heading.
(org-test-with-temp-text "
* H1
** H2
Text <point>"
(should (= 1 (org-up-heading-safe)))
(should (looking-at-p "^\\* H1")))
;; Test inlinetask.
(let ((org-inlinetask-min-level 3))
(org-test-with-temp-text "
** Heading
Text.
*** Inlinetask
Text <point>
*** END"
(should (= 2 (org-up-heading-safe)))
(should (looking-at-p "^\\*\\{2\\} Heading"))))
(let ((org-inlinetask-min-level 3))
(org-test-with-temp-text "
** Heading
Text.
*** Inlinetask<point>"
(should (= 2 (org-up-heading-safe)))
(should (looking-at-p "^\\*\\{2\\} Heading"))))
;; Respect narrowing.
(org-test-with-temp-text "
* H1
** text
** H2<point>"
(save-excursion
(search-backward "** text")
(narrow-to-region (point) (point-max)))
(should-not (org-up-heading-safe))
(should (looking-at-p "^\\*\\* H2"))))
(ert-deftest test-org/get-heading ()
"Test `org-get-heading' specifications."
;; Return current heading, even if point is not on it.