diff --git a/lisp/org-element.el b/lisp/org-element.el index b0fbbe2a7..a14b9a41d 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -5812,6 +5812,30 @@ Providing it allows for quicker computation." ;; Store results in cache, if applicable. (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) "Non-nil when elements ELEM-A and ELEM-B are nested." (let ((beg-A (org-element-property :begin elem-A)) diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 7f7c9cb9d..bf031ac7b 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -3253,6 +3253,52 @@ Text (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*\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*\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*\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*\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*\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*\n#+END_CENTER" + (org-element-lineage (org-element-context) '(bold) t)))) + + ;;; Test Cache.