mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-09-29 20:37:51 +00:00
org-element: Implement `org-element-lineage'
* lisp/org-element.el (org-element-lineage): New function. * testing/lisp/test-org-element.el (test-org-element/lineage): New test.
This commit is contained in:
parent
4c4f91800e
commit
182d61fc8f
|
@ -5812,6 +5812,30 @@ Providing it allows for quicker computation."
|
||||||
;; Store results in cache, if applicable.
|
;; Store results in cache, if applicable.
|
||||||
(org-element--cache-put element cache)))))))
|
(org-element--cache-put element cache)))))))
|
||||||
|
|
||||||
|
(defun org-element-lineage (blob &optional types with-self)
|
||||||
|
"List all BLOB's ancestors, including BLOB.
|
||||||
|
|
||||||
|
BLOB is an object or element.
|
||||||
|
|
||||||
|
When optional argument TYPES is a list of symbols, return the
|
||||||
|
first element or object in the lineage whose type belongs to that
|
||||||
|
list.
|
||||||
|
|
||||||
|
When optional argument WITH-SELF is non-nil, lineage includes
|
||||||
|
BLOB itself as the first element and TYPES, if provided, also
|
||||||
|
apply to it.
|
||||||
|
|
||||||
|
When BLOB is obtained through `org-element-context' or
|
||||||
|
`org-element-at-point', only ancestors from its section can be
|
||||||
|
found. There is no such limitation when BLOB belongs to a full
|
||||||
|
parse tree."
|
||||||
|
(let ((up (if with-self blob (org-element-property :parent blob)))
|
||||||
|
ancestors)
|
||||||
|
(while (and up (not (memq (org-element-type up) types)))
|
||||||
|
(unless types (push up ancestors))
|
||||||
|
(setq up (org-element-property :parent up)))
|
||||||
|
(if types up (nreverse ancestors))))
|
||||||
|
|
||||||
(defun org-element-nested-p (elem-A elem-B)
|
(defun org-element-nested-p (elem-A elem-B)
|
||||||
"Non-nil when elements ELEM-A and ELEM-B are nested."
|
"Non-nil when elements ELEM-A and ELEM-B are nested."
|
||||||
(let ((beg-A (org-element-property :begin elem-A))
|
(let ((beg-A (org-element-property :begin elem-A))
|
||||||
|
|
|
@ -3253,6 +3253,52 @@ Text
|
||||||
(org-element-type (org-element-context))))))
|
(org-element-type (org-element-context))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;;; Test Tools
|
||||||
|
|
||||||
|
(ert-deftest test-org-element/lineage ()
|
||||||
|
"Test `org-element-lineage' specifications."
|
||||||
|
;; Regular tests. When applied to an element or object returned by
|
||||||
|
;; `org-element-at-point' or `org-element-context', the list is
|
||||||
|
;; limited to the current section.
|
||||||
|
(should
|
||||||
|
(equal '(paragraph center-block)
|
||||||
|
(org-test-with-temp-text
|
||||||
|
"* H1\n** H2\n#+BEGIN_CENTER\n*bold<point>*\n#+END_CENTER"
|
||||||
|
(mapcar #'car (org-element-lineage (org-element-context))))))
|
||||||
|
(should
|
||||||
|
(equal '(paragraph center-block section headline headline org-data)
|
||||||
|
(org-test-with-temp-text
|
||||||
|
"* H1\n** H2\n#+BEGIN_CENTER\n*bold<point>*\n#+END_CENTER"
|
||||||
|
(mapcar #'car
|
||||||
|
(org-element-lineage
|
||||||
|
(org-element-map (org-element-parse-buffer) 'bold
|
||||||
|
#'identity nil t))))))
|
||||||
|
;; Test TYPES optional argument.
|
||||||
|
(should
|
||||||
|
(eq 'center-block
|
||||||
|
(org-test-with-temp-text
|
||||||
|
"* H1\n** H2\n#+BEGIN_CENTER\n*bold<point>*\n#+END_CENTER"
|
||||||
|
(org-element-type
|
||||||
|
(org-element-lineage (org-element-context) '(center-block))))))
|
||||||
|
(should-not
|
||||||
|
(org-test-with-temp-text
|
||||||
|
"* H1\n** H2\n#+BEGIN_CENTER\n*bold<point>*\n#+END_CENTER"
|
||||||
|
(org-element-lineage (org-element-context) '(example-block))))
|
||||||
|
;; Test WITH-SELF optional argument.
|
||||||
|
(should
|
||||||
|
(equal '(bold paragraph center-block)
|
||||||
|
(org-test-with-temp-text
|
||||||
|
"* H1\n** H2\n#+BEGIN_CENTER\n*bold<point>*\n#+END_CENTER"
|
||||||
|
(mapcar #'car (org-element-lineage (org-element-context) nil t)))))
|
||||||
|
;; When TYPES and WITH-SELF are provided, the latter is also checked
|
||||||
|
;; against the former.
|
||||||
|
(should
|
||||||
|
(org-test-with-temp-text
|
||||||
|
"* H1\n** H2\n#+BEGIN_CENTER\n*bold<point>*\n#+END_CENTER"
|
||||||
|
(org-element-lineage (org-element-context) '(bold) t))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; Test Cache.
|
;;; Test Cache.
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue