diff --git a/lisp/org-element.el b/lisp/org-element.el index 7050b75ac..d57389e90 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -428,6 +428,16 @@ The function takes care of setting `:parent' property for NEW." ;; Transfer type. (setcar old (car new))) +(defun org-element-secondary-p (object) + "Non-nil when OBJECT belongs to a secondary string. +Return value is the property name, as a keyword, or nil." + (let* ((parent (org-element-property :parent object)) + (property (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)))) + (and property + (memq object (org-element-property property parent)) + property))) + (defsubst org-element-adopt-elements (parent &rest children) "Append elements to the contents of another element. diff --git a/lisp/ox.el b/lisp/ox.el index feed0aa71..ad6ee04ae 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -5220,27 +5220,19 @@ When optional argument N is a positive integer, return a list containing up to N siblings before BLOB, from farthest to closest. With any other non-nil value, return a list containing all of them." - (let ((siblings - ;; An object can belong to the contents of its parent or - ;; to a secondary string. We check the latter option - ;; first. - (let ((parent (org-export-get-parent blob))) - (or (let ((sec-value (org-element-property - (cdr (assq (org-element-type parent) - org-element-secondary-value-alist)) - parent))) - (and (memq blob sec-value) sec-value)) - (org-element-contents parent)))) - prev) + (let* ((secondary (org-element-secondary-p blob)) + (parent (org-export-get-parent blob)) + (siblings + (if secondary (org-element-property secondary parent) + (org-element-contents parent))) + prev) (catch 'exit - (mapc (lambda (obj) - (cond ((memq obj (plist-get info :ignore-list))) - ((null n) (throw 'exit obj)) - ((not (wholenump n)) (push obj prev)) - ((zerop n) (throw 'exit prev)) - (t (decf n) (push obj prev)))) - (cdr (memq blob (reverse siblings)))) - prev))) + (dolist (obj (cdr (memq blob (reverse siblings))) prev) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj prev)) + ((zerop n) (throw 'exit prev)) + (t (decf n) (push obj prev))))))) (defun org-export-get-next-element (blob info &optional n) "Return next element or object. @@ -5253,26 +5245,20 @@ When optional argument N is a positive integer, return a list containing up to N siblings after BLOB, from closest to farthest. With any other non-nil value, return a list containing all of them." - (let ((siblings - ;; An object can belong to the contents of its parent or to - ;; a secondary string. We check the latter option first. - (let ((parent (org-export-get-parent blob))) - (or (let ((sec-value (org-element-property - (cdr (assq (org-element-type parent) - org-element-secondary-value-alist)) - parent))) - (cdr (memq blob sec-value))) - (cdr (memq blob (org-element-contents parent)))))) - next) + (let* ((secondary (org-element-secondary-p blob)) + (parent (org-export-get-parent blob)) + (siblings + (cdr (memq blob + (if secondary (org-element-property secondary parent) + (org-element-contents parent))))) + next) (catch 'exit - (mapc (lambda (obj) - (cond ((memq obj (plist-get info :ignore-list))) - ((null n) (throw 'exit obj)) - ((not (wholenump n)) (push obj next)) - ((zerop n) (throw 'exit (nreverse next))) - (t (decf n) (push obj next)))) - siblings) - (nreverse next)))) + (dolist (obj siblings (nreverse next)) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj next)) + ((zerop n) (throw 'exit (nreverse next))) + (t (decf n) (push obj next))))))) ;;;; Translation diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 2b901dc63..5e560f146 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -141,6 +141,22 @@ Some other text (org-element-map tree 'italic 'identity nil t)) (org-element-map tree 'paragraph 'identity nil t)))))) +(ert-deftest test-org-element/secondary-p () + "Test `org-element-secondary-p' specifications." + ;; In a secondary string, return property name. + (should + (eq :title + (org-test-with-temp-text "* Headline *object*" + (org-element-map (org-element-parse-buffer) 'bold + (lambda (object) (org-element-secondary-p object)) + nil t)))) + ;; Outside a secondary string, return nil. + (should-not + (org-test-with-temp-text "Paragraph *object*" + (org-element-map (org-element-parse-buffer) 'bold + (lambda (object) (org-element-type (org-element-secondary-p object))) + nil t)))) + (ert-deftest test-org-element/adopt-elements () "Test `org-element-adopt-elements' specifications." ;; Adopt an element.