summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2013-12-01 15:48:54 +0100
committerNicolas Goaziou <n.goaziou@gmail.com>2013-12-01 17:05:34 +0100
commitcd439bc5138fc22a4f2532f90c87629c1deec3e3 (patch)
treee10d29ed1aab3d89192becb66d0da800e9669fea
parent798ad3a27e807cff122666a039abd20abd4bc383 (diff)
downloadorg-mode-cd439bc5138fc22a4f2532f90c87629c1deec3e3.tar.gz
org-element: Extend `org-element-set-element' to strings
* 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.
-rw-r--r--lisp/org-element.el40
-rw-r--r--testing/lisp/test-org-element.el68
2 files changed, 74 insertions, 34 deletions
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 0cd2cef..9183a67 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -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
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 486edb7..307f34b 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -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