forked from mirrors/org-mode
org-element: Modify output from `org-element-at-point' and `org-element-context'
* lisp/org-element.el (org-element-at-point): Add :parent property to output. (org-element-context): Add :parent property to output. Also return a single element or object instead of a list of parents. (org-element-forward, org-element-up): Apply changes. * testing/lisp/test-org-element.el: Add tests.
This commit is contained in:
Nicolas Goaziou
parent
8466541b1d
commit
7cf9e5afb5
|
|
@ -4042,8 +4042,11 @@ indentation is not done with TAB characters."
|
|||
|
||||
Return value is a list like (TYPE PROPS) where TYPE is the type
|
||||
of the element and PROPS a plist of properties associated to the
|
||||
element. Possible types are defined in
|
||||
`org-element-all-elements'.
|
||||
element.
|
||||
|
||||
Possible types are defined in `org-element-all-elements'.
|
||||
Properties depend on element or object type, but always
|
||||
include :begin, :end, :parent and :post-blank properties.
|
||||
|
||||
As a special case, if point is at the very beginning of a list or
|
||||
sub-list, returned element will be that list instead of the first
|
||||
|
|
@ -4070,7 +4073,7 @@ first element of current section."
|
|||
(let ((origin (point))
|
||||
(end (save-excursion
|
||||
(org-with-limited-levels (outline-next-heading)) (point)))
|
||||
element type special-flag trail struct prevs)
|
||||
element type special-flag trail struct prevs parent)
|
||||
(org-with-limited-levels
|
||||
(if (org-with-limited-levels (org-before-first-heading-p))
|
||||
(goto-char (point-min))
|
||||
|
|
@ -4085,7 +4088,8 @@ first element of current section."
|
|||
(setq element
|
||||
(org-element--current-element end 'element special-flag struct)
|
||||
type (car element))
|
||||
(push element trail)
|
||||
(org-element-put-property element :parent parent)
|
||||
(when keep-trail (push element trail))
|
||||
(cond
|
||||
;; 1. Skip any element ending before point or at point
|
||||
;; because the following element has started. On the
|
||||
|
|
@ -4113,6 +4117,7 @@ first element of current section."
|
|||
(and (= cend origin) (/= (point-max) origin))
|
||||
(and (= cbeg origin) (memq type '(plain-list table))))
|
||||
(throw 'exit (if keep-trail trail element))
|
||||
(setq parent element)
|
||||
(case type
|
||||
(plain-list
|
||||
(setq special-flag 'item
|
||||
|
|
@ -4123,25 +4128,21 @@ first element of current section."
|
|||
(goto-char cbeg)))))))))))
|
||||
|
||||
(defun org-element-context ()
|
||||
"Return list of all elements and objects around point.
|
||||
"Return closest element or object around point.
|
||||
|
||||
Return value is a list like (TYPE PROPS) where TYPE is the type
|
||||
of the element or object and PROPS a plist of properties
|
||||
associated to it. Possible types are defined in
|
||||
`org-element-all-elements' and `org-element-all-objects'.
|
||||
associated to it.
|
||||
|
||||
All elements and objects returned belong to the current section
|
||||
and are ordered from closest to farthest."
|
||||
Possible types are defined in `org-element-all-elements' and
|
||||
`org-element-all-objects'. Properties depend on element or
|
||||
object type, but always include :begin, :end, :parent
|
||||
and :post-blank properties."
|
||||
(org-with-wide-buffer
|
||||
(let* ((origin (point))
|
||||
;; Remove elements not containing point from trail.
|
||||
(elements (org-remove-if
|
||||
(lambda (el)
|
||||
(or (> (org-element-property :begin el) origin)
|
||||
(< (org-element-property :end el) origin)))
|
||||
(org-element-at-point 'keep-trail)))
|
||||
(element (car elements))
|
||||
(type (car element)) end)
|
||||
(element (org-element-at-point))
|
||||
(type (car element))
|
||||
end)
|
||||
;; Check if point is inside an element containing objects or at
|
||||
;; a secondary string. In that case, move to beginning of the
|
||||
;; element or secondary string and set END to the other side.
|
||||
|
|
@ -4162,7 +4163,7 @@ and are ordered from closest to farthest."
|
|||
(progn (beginning-of-line)
|
||||
(skip-chars-forward "* ")
|
||||
(setq end (point-at-eol))))
|
||||
(and (memq (car element) '(paragraph table-cell verse-block))
|
||||
(and (memq type '(paragraph table-cell verse-block))
|
||||
(let ((cbeg (org-element-property
|
||||
:contents-begin element))
|
||||
(cend (org-element-property
|
||||
|
|
@ -4170,8 +4171,10 @@ and are ordered from closest to farthest."
|
|||
(and (>= origin cbeg)
|
||||
(<= origin cend)
|
||||
(progn (goto-char cbeg) (setq end cend)))))))
|
||||
elements
|
||||
(let ((restriction (org-element-restriction element)) candidates)
|
||||
element
|
||||
(let ((restriction (org-element-restriction element))
|
||||
(parent element)
|
||||
candidates)
|
||||
(catch 'exit
|
||||
(while (setq candidates (org-element--get-next-object-candidates
|
||||
end restriction candidates))
|
||||
|
|
@ -4179,7 +4182,7 @@ and are ordered from closest to farthest."
|
|||
candidates)))
|
||||
;; If ORIGIN is before next object in element, there's
|
||||
;; no point in looking further.
|
||||
(if (> (cdr closest-cand) origin) (throw 'exit elements)
|
||||
(if (> (cdr closest-cand) origin) (throw 'exit element)
|
||||
(let* ((object
|
||||
(progn (goto-char (cdr closest-cand))
|
||||
(funcall (intern (format "org-element-%s-parser"
|
||||
|
|
@ -4193,13 +4196,14 @@ and are ordered from closest to farthest."
|
|||
;; ORIGIN is within a non-recursive object or at an
|
||||
;; object boundaries: Return that object.
|
||||
((or (not cbeg) (> cbeg origin) (< cend origin))
|
||||
(throw 'exit (cons object elements)))
|
||||
(throw 'exit
|
||||
(org-element-put-property object :parent parent)))
|
||||
;; Otherwise, move within current object and restrict
|
||||
;; search to the end of its contents.
|
||||
(t (goto-char cbeg)
|
||||
(setq end cend)
|
||||
(push object elements)))))))
|
||||
elements))))))
|
||||
(org-element-put-property object :parent parent)
|
||||
(setq parent object end cend)))))))
|
||||
parent))))))
|
||||
|
||||
|
||||
;; Once the local structure around point is well understood, it's easy
|
||||
|
|
@ -4300,23 +4304,20 @@ end of ELEM-A."
|
|||
"Move forward by one element.
|
||||
Move to the next element at the same level, when possible."
|
||||
(interactive)
|
||||
(if (org-with-limited-levels (org-at-heading-p))
|
||||
(let ((origin (point)))
|
||||
(org-forward-same-level 1)
|
||||
(unless (org-with-limited-levels (org-at-heading-p))
|
||||
(goto-char origin)
|
||||
(error "Cannot move further down")))
|
||||
(let* ((trail (org-element-at-point 'keep-trail))
|
||||
(elem (pop trail))
|
||||
(end (org-element-property :end elem))
|
||||
(parent (loop for prev in trail
|
||||
when (>= (org-element-property :end prev) end)
|
||||
return prev)))
|
||||
(cond
|
||||
((eobp) (error "Cannot move further down"))
|
||||
((and parent (= (org-element-property :contents-end parent) end))
|
||||
(goto-char (org-element-property :end parent)))
|
||||
(t (goto-char end))))))
|
||||
(cond ((eobp) (error "Cannot move further down"))
|
||||
((org-with-limited-levels (org-at-heading-p))
|
||||
(let ((origin (point)))
|
||||
(org-forward-same-level 1)
|
||||
(unless (org-with-limited-levels (org-at-heading-p))
|
||||
(goto-char origin)
|
||||
(error "Cannot move further down"))))
|
||||
(t
|
||||
(let* ((elem (org-element-at-point))
|
||||
(end (org-element-property :end elem))
|
||||
(parent (org-element-property :parent elem)))
|
||||
(if (and parent (= (org-element-property :contents-end parent) end))
|
||||
(goto-char (org-element-property :end parent))
|
||||
(goto-char end))))))
|
||||
|
||||
(defun org-element-backward ()
|
||||
"Move backward by one element.
|
||||
|
|
@ -4345,18 +4346,13 @@ Move to the previous element at the same level, when possible."
|
|||
"Move to upper element."
|
||||
(interactive)
|
||||
(if (org-with-limited-levels (org-at-heading-p))
|
||||
(unless (org-up-heading-safe)
|
||||
(error "No surrounding element"))
|
||||
(let* ((trail (org-element-at-point 'keep-trail))
|
||||
(elem (pop trail))
|
||||
(end (org-element-property :end elem))
|
||||
(parent (loop for prev in trail
|
||||
when (>= (org-element-property :end prev) end)
|
||||
return prev)))
|
||||
(cond
|
||||
(parent (goto-char (org-element-property :begin parent)))
|
||||
((org-before-first-heading-p) (error "No surrounding element"))
|
||||
(t (org-back-to-heading))))))
|
||||
(unless (org-up-heading-safe) (error "No surrounding element"))
|
||||
(let* ((elem (org-element-at-point))
|
||||
(parent (org-element-property :parent elem)))
|
||||
(if parent (goto-char (org-element-property :begin parent))
|
||||
(if (org-with-limited-levels (org-before-first-heading-p))
|
||||
(error "No surrounding element")
|
||||
(org-with-limited-levels (org-back-to-heading)))))))
|
||||
|
||||
(defun org-element-down ()
|
||||
"Move to inner element."
|
||||
|
|
|
|||
|
|
@ -2225,6 +2225,19 @@ Paragraph \\alpha."
|
|||
|
||||
(ert-deftest test-org-element/at-point ()
|
||||
"Test `org-element-at-point' specifications."
|
||||
;; Return closest element containing point.
|
||||
(should
|
||||
(eq 'paragraph
|
||||
(org-test-with-temp-text "#+BEGIN_CENTER\nA\n#+END_CENTER"
|
||||
(progn (search-forward "A")
|
||||
(org-element-type (org-element-at-point))))))
|
||||
;; Correctly set `:parent' property.
|
||||
(should
|
||||
(eq 'center-block
|
||||
(org-test-with-temp-text "#+BEGIN_CENTER\nA\n#+END_CENTER"
|
||||
(progn (search-forward "A")
|
||||
(org-element-type
|
||||
(org-element-property :parent (org-element-at-point)))))))
|
||||
;; Special case: at the very beginning of a table, return `table'
|
||||
;; object instead of `table-row'.
|
||||
(should
|
||||
|
|
@ -2236,26 +2249,35 @@ Paragraph \\alpha."
|
|||
(should
|
||||
(eq 'plain-list
|
||||
(org-test-with-temp-text "- item"
|
||||
(org-element-type (org-element-at-point))))))
|
||||
(org-element-type (org-element-at-point)))))
|
||||
;; With an optional argument, return trail.
|
||||
(should
|
||||
(equal '(paragraph center-block)
|
||||
(org-test-with-temp-text "#+BEGIN_CENTER\nA\n#+END_CENTER\nZ"
|
||||
(progn (search-forward "Z")
|
||||
(mapcar 'org-element-type (org-element-at-point t)))))))
|
||||
|
||||
(ert-deftest test-org-element/context ()
|
||||
"Test `org-element-context' specifications."
|
||||
;; List all objects and elements containing point.
|
||||
;; Return closest object containing point.
|
||||
(should
|
||||
(equal
|
||||
'(subscript bold paragraph)
|
||||
(mapcar 'car
|
||||
(org-test-with-temp-text "Some *text with _underline_*"
|
||||
(progn (search-forward "under")
|
||||
(org-element-context))))))
|
||||
(eq 'underline
|
||||
(org-test-with-temp-text "Some *text with _underline_ text*"
|
||||
(progn (search-forward "under")
|
||||
(org-element-type (org-element-context))))))
|
||||
;; Find objects in secondary strings.
|
||||
(should
|
||||
(equal
|
||||
'(underline headline)
|
||||
(mapcar 'car
|
||||
(org-test-with-temp-text "* Headline _with_ underlining"
|
||||
(progn (search-forward "w")
|
||||
(org-element-context)))))))
|
||||
(eq 'underline
|
||||
(org-test-with-temp-text "* Headline _with_ underlining"
|
||||
(progn (search-forward "w")
|
||||
(org-element-type (org-element-context))))))
|
||||
;; Correctly set `:parent' property.
|
||||
(should
|
||||
(eq 'paragraph
|
||||
(org-test-with-temp-text "Some *bold* text"
|
||||
(progn (search-forward "bold")
|
||||
(org-element-type
|
||||
(org-element-property :parent (org-element-context))))))))
|
||||
|
||||
(ert-deftest test-org-element/forward ()
|
||||
"Test `org-element-forward' specifications."
|
||||
|
|
|
|||
Loading…
Reference in New Issue