diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el index 8dcd1c15b..add9740db 100644 --- a/contrib/lisp/org-element.el +++ b/contrib/lisp/org-element.el @@ -2989,8 +2989,10 @@ CONTENTS is nil." ;; `org-element-contents' and `org-element-restriction'. ;; ;; Setter functions allow to modify elements by side effect. There is -;;`org-element-put-property', `org-element-set-contents' and -;;`org-element-adopt-contents'. +;; `org-element-put-property', `org-element-set-contents', +;; `org-element-set-element' and `org-element-adopt-element'. Note +;; that `org-element-set-element' and `org-element-adopt-element' are +;; higher level functions since also update `:parent' property. (defun org-element-type (element) "Return type of ELEMENT. @@ -3030,6 +3032,21 @@ Return modified element." Return modified element." (setcdr (cdr element) contents)) +(defsubst org-element-set-element (old new) + "Replace element or object OLD with element or object NEW. +The function takes care of setting `:parent' property for NEW." + ;; OLD can belong to the contents of PARENT or to its secondary + ;; string. + (let* ((parent (org-element-property :parent old)) + (sec-loc (cdr (assq (org-element-type parent) + org-element-secondary-value-alist))) + (sec-value (and sec-loc (org-element-property sec-loc parent))) + (place (or (member old sec-value) (member old parent)))) + ;; Make sure NEW has correct `:parent' property. + (org-element-put-property new :parent parent) + ;; Replace OLD with NEW in PARENT. + (setcar place new))) + (defsubst org-element-adopt-element (parent child &optional append) "Add an element to the contents of another element. diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el index 149120814..c1621b4f7 100644 --- a/contrib/lisp/org-export.el +++ b/contrib/lisp/org-export.el @@ -2245,10 +2245,6 @@ channel, as a plist. It must return a string or nil.") ;; Internal function `org-export-filter-apply-functions' takes care ;; about applying each filter in order to a given data. It stops ;; whenever a filter returns a nil value. -;; -;; User-oriented function `org-export-set-element' replaces one -;; element or object in the parse tree with another one. It is meant -;; to be used as a tool for parse tree filters. (defun org-export-filter-apply-functions (filters value info) "Call every function in FILTERS. @@ -2288,22 +2284,6 @@ Return the updated communication channel." ;; Return new communication channel. (org-combine-plists info plist))) -(defun org-export-set-element (old new) - "Replace element or object OLD with element or object NEW. -The function takes care of setting `:parent' property for NEW." - ;; OLD can belong to the contents of PARENT or to its secondary - ;; string. - (let* ((parent (org-element-property :parent old)) - (sec-loc (cdr (assq (org-element-type parent) - org-element-secondary-value-alist))) - (sec-value (and sec-loc (org-element-property sec-loc parent))) - (place (or (member old sec-value) (member old parent)))) - ;; Ensure NEW has correct parent. Then replace OLD with NEW. - (let ((props (nth 1 new))) - (if props (plist-put props :parent parent) - (setcar (cdr new) `(:parent ,parent)))) - (setcar place new))) - ;;; Core functions diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 338e8761e..4f486fd7e 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -106,6 +106,22 @@ Some other text (org-element-set-contents (org-element-map tree 'bold 'identity nil t)) (org-element-contents (org-element-map tree 'bold 'identity nil t))))) +(ert-deftest test-org-element/set-element () + "Test `org-element-set-element' specifications." + (org-test-with-parsed-data "* Headline\n*a*" + (org-element-set-element + (org-element-map tree 'bold 'identity nil t) + '(italic nil "b")) + ;; Check if object is correctly replaced. + (should (org-element-map tree 'italic 'identity)) + (should-not (org-element-map tree 'bold 'identity)) + ;; Check if new object's parent is correctly set. + (should + (equal + (org-element-property :parent + (org-element-map tree 'italic 'identity nil t)) + (org-element-map tree 'paragraph 'identity nil t))))) + (ert-deftest test-org-element/adopt-element () "Test `org-element-adopt-element' specifications." ;; Adopt an element. diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el index af78055b4..9c773cead 100644 --- a/testing/lisp/test-org-export.el +++ b/testing/lisp/test-org-export.el @@ -392,22 +392,6 @@ body\n"))) (delete-region (point) (progn (forward-line) (point))))))))) (should (equal (org-export-as 'test) "Body 1\nBody 2\n")))))) -(ert-deftest test-org-export/set-element () - "Test `org-export-set-element' specifications." - (org-test-with-parsed-data "* Headline\n*a*" - (org-export-set-element - (org-element-map tree 'bold 'identity nil t) - '(italic nil "b")) - ;; Check if object is correctly replaced. - (should (org-element-map tree 'italic 'identity)) - (should-not (org-element-map tree 'bold 'identity)) - ;; Check if new object's parent is correctly set. - (should - (equal - (org-element-property :parent - (org-element-map tree 'italic 'identity nil t)) - (org-element-map tree 'paragraph 'identity nil t))))) - ;;; Affiliated Keywords