From cd439bc5138fc22a4f2532f90c87629c1deec3e3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 1 Dec 2013 15:48:54 +0100 Subject: [PATCH] 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. --- lisp/org-element.el | 40 +++++++++++-------- testing/lisp/test-org-element.el | 68 ++++++++++++++++++++++++-------- 2 files changed, 74 insertions(+), 34 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 0cd2cef53..9183a6728 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 486edb7a2..307f34b9a 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