Browse Source

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.
Nicolas Goaziou 11 years ago
parent
commit
cd439bc513
2 changed files with 74 additions and 34 deletions
  1. 23 17
      lisp/org-element.el
  2. 51 17
      testing/lisp/test-org-element.el

+ 23 - 17
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

+ 51 - 17
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