mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-29 07:58:21 +00:00
Code

org-element: Extend `org-element-set-element' to strings

Browse Source 
* lisp/org-element.el (org-element-set-element): Allow to replace
  a string with an element, an element with a string, or a string with
  a string.
This commit is contained in:
Nicolas Goaziou 2013-12-01 15:48:54 +01:00
parent 798ad3a27e
commit cd439bc513
2 changed files with 74 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
lisp/org-element.el
View File

@ -416,23 +416,6 @@ Return modified element."
((cdr element) (setcdr (cdr element) contents))
(t (nconc 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."
;; Since OLD is going to be changed into NEW by side-effect, first
;; make sure that every element or object within NEW has OLD as
;; parent.
(mapc (lambda (blob) (org-element-put-property blob :parent old))
(org-element-contents new))
;; Transfer contents.
(apply 'org-element-set-contents old (org-element-contents new))
;; Ensure NEW has same parent as OLD, then overwrite OLD properties
;; with NEW's.
(org-element-put-property new :parent (org-element-property :parent old))
(setcar (cdr old) (nth 1 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."
@ -503,6 +486,29 @@ Parse tree is modified by side effect."
;; Set appropriate :parent property.
(org-element-put-property element :parent parent)))
(defun 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."
;; Ensure OLD and NEW have the same parent.
(org-element-put-property new :parent (org-element-property :parent old))
(if (or (memq (org-element-type old) '(plain-text nil))
(memq (org-element-type new) '(plain-text nil)))
;; We cannot replace OLD with NEW since one of them is not an
;; object or element. We take the long path.
(progn (org-element-insert-before new old)
(org-element-extract-element old))
;; Since OLD is going to be changed into NEW by side-effect, first
;; make sure that every element or object within NEW has OLD as
;; parent.
(dolist (blob (org-element-contents new))
(org-element-put-property blob :parent old))
;; Transfer contents.
(apply #'org-element-set-contents old (org-element-contents new))
;; Overwrite OLD's properties with NEW's.
(setcar (cdr old) (nth 1 new))
;; Transfer type.
(setcar old (car new))))
;;; Greater elements

68
testing/lisp/test-org-element.el
View File

@ -124,23 +124,6 @@ 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-temp-text "* Headline\n*a*"
(let ((tree (org-element-parse-buffer)))
(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
(eq
(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/secondary-p ()
"Test `org-element-secondary-p' specifications."
;; In a secondary string, return property name.
@ -251,6 +234,57 @@ Some other text
(org-element-map (org-element-property :title headline) '(entity italic)
#'org-element-type))))))
(ert-deftest test-org-element/set-element ()
"Test `org-element-set-element' specifications."
;; Check if new element is inserted.
(should
(org-test-with-temp-text "* Headline\n*a*"
(let* ((tree (org-element-parse-buffer))
(bold (org-element-map tree 'bold 'identity nil t)))
(org-element-set-element bold '(italic nil "b"))
(org-element-map tree 'italic 'identity))))
;; Check if old element is removed.
(should-not
(org-test-with-temp-text "* Headline\n*a*"
(let* ((tree (org-element-parse-buffer))
(bold (org-element-map tree 'bold 'identity nil t)))
(org-element-set-element bold '(italic nil "b"))
(org-element-map tree 'bold 'identity))))
;; Check if :parent property is correctly set.
(should
(eq 'paragraph
(org-test-with-temp-text "* Headline\n*a*"
(let* ((tree (org-element-parse-buffer))
(bold (org-element-map tree 'bold 'identity nil t)))
(org-element-set-element bold '(italic nil "b"))
(org-element-type
(org-element-property
:parent (org-element-map tree 'italic 'identity nil t)))))))
;; Allow to replace strings with elements.
(should
(equal '("b")
(org-test-with-temp-text "* Headline"
(let* ((tree (org-element-parse-buffer))
(text (org-element-map tree 'plain-text 'identity nil t)))
(org-element-set-element text (list 'bold nil "b"))
(org-element-map tree 'plain-text 'identity)))))
;; Allow to replace elements with strings.
(should
(equal "a"
(org-test-with-temp-text "* =verbatim="
(let* ((tree (org-element-parse-buffer))
(verb (org-element-map tree 'verbatim 'identity nil t)))
(org-element-set-element verb "a")
(org-element-map tree 'plain-text 'identity nil t)))))
;; Allow to replace strings with strings.
(should
(equal "b"
(org-test-with-temp-text "a"
(let* ((tree (org-element-parse-buffer))
(text (org-element-map tree 'plain-text 'identity nil t)))
(org-element-set-element text "b")
(org-element-map tree 'plain-text 'identity nil t))))))
;;; Test Parsers