org-element: Rename `org-export-set-element' into `org-element-set-element'

* contrib/lisp/org-element.el (org-element-set-element): New function.
* contrib/lisp/org-export.el (org-export-set-element): Removed function.
* testing/lisp/test-org-element.el: Add test.
* testing/lisp/test-org-export.el: Remove test.
This commit is contained in:
Nicolas Goaziou 2012-07-10 17:29:13 +02:00
parent d9f975cf7b
commit bb9a26389c
4 changed files with 35 additions and 38 deletions

View File

@ -2989,8 +2989,10 @@ CONTENTS is nil."
;; `org-element-contents' and `org-element-restriction'. ;; `org-element-contents' and `org-element-restriction'.
;; ;;
;; Setter functions allow to modify elements by side effect. There is ;; Setter functions allow to modify elements by side effect. There is
;;`org-element-put-property', `org-element-set-contents' and ;; `org-element-put-property', `org-element-set-contents',
;;`org-element-adopt-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) (defun org-element-type (element)
"Return type of ELEMENT. "Return type of ELEMENT.
@ -3030,6 +3032,21 @@ Return modified element."
Return modified element." Return modified element."
(setcdr (cdr element) contents)) (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) (defsubst org-element-adopt-element (parent child &optional append)
"Add an element to the contents of another element. "Add an element to the contents of another element.

View File

@ -2245,10 +2245,6 @@ channel, as a plist. It must return a string or nil.")
;; Internal function `org-export-filter-apply-functions' takes care ;; Internal function `org-export-filter-apply-functions' takes care
;; about applying each filter in order to a given data. It stops ;; about applying each filter in order to a given data. It stops
;; whenever a filter returns a nil value. ;; 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) (defun org-export-filter-apply-functions (filters value info)
"Call every function in FILTERS. "Call every function in FILTERS.
@ -2288,22 +2284,6 @@ Return the updated communication channel."
;; Return new communication channel. ;; Return new communication channel.
(org-combine-plists info plist))) (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 ;;; Core functions

View File

@ -106,6 +106,22 @@ Some other text
(org-element-set-contents (org-element-map tree 'bold 'identity nil t)) (org-element-set-contents (org-element-map tree 'bold 'identity nil t))
(org-element-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 () (ert-deftest test-org-element/adopt-element ()
"Test `org-element-adopt-element' specifications." "Test `org-element-adopt-element' specifications."
;; Adopt an element. ;; Adopt an element.

View File

@ -392,22 +392,6 @@ body\n")))
(delete-region (point) (progn (forward-line) (point))))))))) (delete-region (point) (progn (forward-line) (point)))))))))
(should (equal (org-export-as 'test) "Body 1\nBody 2\n")))))) (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 ;;; Affiliated Keywords