From d9f975cf7baf23095cc816116670d9e7bda835d3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 10 Jul 2012 17:21:36 +0200 Subject: [PATCH] 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 | 40 ++++++++++++++++- testing/lisp/test-org-element.el | 76 +++++++++++++++++++++++++++++++- 2 files changed, 112 insertions(+), 4 deletions(-) diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el index fb0dbf662..8dcd1c15b 100644 --- a/contrib/lisp/org-element.el +++ b/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 diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index ad8bc0be6..338e8761e 100644 --- a/testing/lisp/test-org-element.el +++ b/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."