org-element: Add setters to modify parse tree

* contrib/lisp/org-element.el (org-element-put-property,
  org-element-set-contents, org-element-adopt-element): New
  functions.
* testing/lisp/test-org-element.el: Add tests.

contrib/lisp/org-element.el

@@ -2983,13 +2983,17 @@ CONTENTS is nil."
 
 
 
-;;; Accessors
+;;; Accessors and Setters
 ;;
 ;; Provide four accessors: `org-element-type', `org-element-property'
 ;; `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'.
 
 (defun org-element-type (element)
-  "Return type of element ELEMENT.
+  "Return type of ELEMENT.
 
 The function returns the type of the element or object provided.
 It can also return the following special value:
@@ -3015,6 +3019,38 @@ element or object type."
   (cdr (assq (if (symbolp element) element (org-element-type element))
 	     org-element-object-restrictions)))
 
+(defsubst org-element-put-property (element property value)
+  "In ELEMENT set PROPERTY to VALUE.
+Return modified element."
+  (setcar (cdr element) (plist-put (nth 1 element) property value))
+  element)
+
+(defsubst org-element-set-contents (element &rest contents)
+  "Set ELEMENT contents to CONTENTS.
+Return modified element."
+  (setcdr (cdr element) contents))
+
+(defsubst org-element-adopt-element (parent child &optional append)
+  "Add an element to the contents of another element.
+
+PARENT is an element or object.  CHILD is an element, an object,
+or a string.
+
+CHILD is added at the beginning of PARENT contents, unless the
+optional argument APPEND is non-nil, in which case CHILD is added
+at the end.
+
+The function takes care of setting `:parent' property for CHILD.
+Return parent element."
+  (let ((contents (org-element-contents parent)))
+    (apply 'org-element-set-contents
+	   parent
+	   (if append (append contents (list child)) (cons child contents))))
+  ;; Link the child element with parent.
+  (when (consp child) (org-element-put-property child :parent parent))
+  ;; Return the parent element.
+  parent)
+
 
 
 ;;; Parsing Element Starting At Point

testing/lisp/test-org-element.el

@@ -63,6 +63,78 @@ Some other text
      (org-element-map
       (org-element-parse-buffer) 'entity 'identity nil nil 'center-block))))
 
+
+
+;;; Test Setters
+
+(ert-deftest test-org-element/put-property ()
+  "Test `org-element-put-property' specifications."
+  (org-test-with-parsed-data "* Headline\n *a*"
+    (org-element-put-property
+     (org-element-map tree 'bold 'identity nil t) :test 1)
+    (should (org-element-property
+	     :test (org-element-map tree 'bold 'identity nil t)))))
+
+(ert-deftest test-org-element/set-contents ()
+  "Test `org-element-set-contents' specifications."
+  ;; Accept multiple entries.
+  (should
+   (equal '("b" (italic nil "a"))
+	  (org-test-with-parsed-data "* Headline\n *a*"
+	    (org-element-set-contents
+	     (org-element-map tree 'bold 'identity nil t) "b" '(italic nil "a"))
+	    (org-element-contents
+	     (org-element-map tree 'bold 'identity nil t)))))
+  ;; Accept atoms and elements.
+  (should
+   (equal '("b")
+	  (org-test-with-parsed-data "* Headline\n *a*"
+	    (org-element-set-contents
+	     (org-element-map tree 'bold 'identity nil t) "b")
+	    (org-element-contents
+	     (org-element-map tree 'bold 'identity nil t)))))
+  (should
+   (equal '((italic nil "b"))
+	  (org-test-with-parsed-data "* Headline\n *a*"
+	    (org-element-set-contents
+	     (org-element-map tree 'bold 'identity nil t) '(italic nil "b"))
+	    (org-element-contents
+	     (org-element-map tree 'bold 'identity nil t)))))
+  ;; Allow nil contents.
+  (should-not
+   (org-test-with-parsed-data "* Headline\n *a*"
+     (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/adopt-element ()
+  "Test `org-element-adopt-element' specifications."
+  ;; Adopt an element.
+  (should
+   (equal '(italic plain-text)
+	  (org-test-with-parsed-data "* Headline\n *a*"
+	    (org-element-adopt-element
+	     (org-element-map tree 'bold 'identity nil t) '(italic nil "a"))
+	    (mapcar (lambda (blob) (org-element-type blob))
+		    (org-element-contents
+		     (org-element-map tree 'bold 'identity nil t))))))
+  ;; Adopt a string.
+  (should
+   (equal '("b" "a")
+	  (org-test-with-parsed-data "* Headline\n *a*"
+	    (org-element-adopt-element
+	     (org-element-map tree 'bold 'identity nil t) "b")
+	    (org-element-contents
+	     (org-element-map tree 'bold 'identity nil t)))))
+  ;; Test APPEND optional argument.
+  (should
+   (equal '("a" "b")
+	  (org-test-with-parsed-data "* Headline\n *a*"
+	    (org-element-adopt-element
+	     (org-element-map tree 'bold 'identity nil t) "b" t)
+	    (org-element-contents
+	     (org-element-map tree 'bold 'identity nil t))))))
+
+
 
 ;;; Test Parsers
 
@@ -1237,7 +1309,7 @@ Outside list"
     '("first line\nsecond line"))))
 
 
-;;; Subscript
+;;;; Subscript
 
 (ert-deftest test-org-element/subscript-parser ()
   "Test `subscript' parser."
@@ -1251,7 +1323,7 @@ Outside list"
      (org-element-map (org-element-parse-buffer) 'subscript 'identity))))
 
 
-;;; Superscript
+;;;; Superscript
 
 (ert-deftest test-org-element/superscript-parser ()
   "Test `superscript' parser."