فهرست منبع

org-element: Implement `org-element-insert-before'

* lisp/org-element.el (org-element-insert-before): New function.
* testing/lisp/test-org-element.el (test-org-element/insert-before):
  New test.
Nicolas Goaziou 11 سال پیش
والد
کامیت
798ad3a27e
2فایلهای تغییر یافته به همراه56 افزوده شده و 4 حذف شده
  1. 32 4
      lisp/org-element.el
  2. 24 0
      testing/lisp/test-org-element.el

+ 32 - 4
lisp/org-element.el

@@ -361,10 +361,15 @@ These variables are copied to the temporary buffer created by
 ;; `org-element-contents' and `org-element-restriction'.
 ;;
 ;; Setter functions allow to modify elements by side effect.  There is
-;; `org-element-put-property', `org-element-set-contents',
-;; `org-element-set-element' and `org-element-adopt-element'.  Note
-;; that `org-element-set-element' and `org-element-adopt-elements' are
-;; higher level functions since also update `:parent' property.
+;; `org-element-put-property', `org-element-set-contents'.  These
+;; low-level functions are useful to build a parse tree.
+;;
+;; `org-element-adopt-element', `org-element-set-element',
+;; `org-element-extract-element' and `org-element-insert-before' are
+;; high-level functions useful to modify a parse tree.
+;;
+;; `org-element-secondary-p' is a predicate used to know if a given
+;; object belongs to a secondary string.
 
 (defsubst org-element-type (element)
   "Return type of ELEMENT.
@@ -475,6 +480,29 @@ with its `:parent' property stripped out."
     ;; Return ELEMENT with its :parent removed.
     (org-element-put-property element :parent nil)))
 
+(defun org-element-insert-before (element location)
+  "Insert ELEMENT before LOCATION in parse tree.
+LOCATION is an element, object or string within the parse tree.
+Parse tree is modified by side effect."
+  (let* ((parent (org-element-property :parent location))
+	 (property (org-element-secondary-p location))
+	 (siblings (if property (org-element-property property parent)
+		     (org-element-contents parent))))
+    ;; Install ELEMENT at the appropriate POSITION within SIBLINGS.
+    (cond ((or (null siblings) (eq (car siblings) location))
+	   (push element siblings))
+	  ((null location) (nconc siblings (list element)))
+	  (t (let ((previous (cadr (memq location (reverse siblings)))))
+	       (if (not previous)
+		   (error "No location found to insert element")
+		 (let ((next (memq previous siblings)))
+		   (setcdr next (cons element (cdr next))))))))
+    ;; Store SIBLINGS at appropriate place in parse tree.
+    (if property (org-element-put-property parent property siblings)
+      (apply #'org-element-set-contents parent siblings))
+    ;; Set appropriate :parent property.
+    (org-element-put-property element :parent parent)))
+
 
 
 ;;; Greater elements

+ 24 - 0
testing/lisp/test-org-element.el

@@ -227,6 +227,30 @@ Some other text
 	     (element (org-element-map tree 'bold 'identity nil t)))
 	(org-element-extract-element element))))))
 
+(ert-deftest test-org-element/insert-before ()
+  "Test `org-element-insert-before' specifications."
+  ;; Standard test.
+  (should
+   (equal
+    '(italic entity bold)
+    (org-test-with-temp-text "/some/ *paragraph*"
+      (let* ((tree (org-element-parse-buffer))
+	     (paragraph (org-element-map tree 'paragraph 'identity nil t))
+	     (bold (org-element-map tree 'bold 'identity nil t)))
+	(org-element-insert-before '(entity (:name "\\alpha")) bold)
+	(org-element-map tree '(bold entity italic) #'org-element-type nil)))))
+  ;; Insert an object in a secondary string.
+  (should
+   (equal
+    '(entity italic)
+    (org-test-with-temp-text "* /A/\n  Paragraph."
+      (let* ((tree (org-element-parse-buffer))
+	     (headline (org-element-map tree 'headline 'identity nil t))
+	     (italic (org-element-map tree 'italic 'identity nil t)))
+	(org-element-insert-before '(entity (:name "\\alpha")) italic)
+	(org-element-map (org-element-property :title headline) '(entity italic)
+	  #'org-element-type))))))
+
 
 
 ;;; Test Parsers