forked from mirrors/org-mode
Factor out pure syntax tree API to org-element-ast.el (copy old functions)
The functions to be modified are copied here for better diffs with subsequent commits.
This commit is contained in:
parent
184b735323
commit
f750f46c9d
|
@ -0,0 +1,209 @@
|
|||
(defsubst org-element-type (element)
|
||||
"Return type of ELEMENT.
|
||||
|
||||
The function returns the type of the element or object provided.
|
||||
It can also return the following special value:
|
||||
`plain-text' for a string
|
||||
`org-data' for a complete document
|
||||
nil in any other case."
|
||||
(cond
|
||||
((not (consp element)) (and (stringp element) 'plain-text))
|
||||
((symbolp (car element)) (car element))))
|
||||
|
||||
(defun org-element-secondary-p (object)
|
||||
"Non-nil when OBJECT directly belongs to a secondary string.
|
||||
Return value is the property name, as a keyword, or nil."
|
||||
(let* ((parent (org-element-property :parent object))
|
||||
(properties (cdr (assq (org-element-type parent)
|
||||
org-element-secondary-value-alist))))
|
||||
(catch 'exit
|
||||
(dolist (p properties)
|
||||
(and (memq object (org-element-property p parent))
|
||||
(throw 'exit p))))))
|
||||
|
||||
(defsubst org-element-property (property element)
|
||||
"Extract the value from the PROPERTY of an ELEMENT."
|
||||
(if (stringp element) (get-text-property 0 property element)
|
||||
(plist-get (nth 1 element) property)))
|
||||
|
||||
(defsubst org-element-put-property (element property value)
|
||||
"In ELEMENT set PROPERTY to VALUE.
|
||||
Return modified element."
|
||||
(if (stringp element) (org-add-props element nil property value)
|
||||
(setcar (cdr element) (plist-put (nth 1 element) property value))
|
||||
element))
|
||||
|
||||
(defsubst org-element-contents (element)
|
||||
"Extract contents from an ELEMENT."
|
||||
(cond ((not (consp element)) nil)
|
||||
((symbolp (car element)) (nthcdr 2 element))
|
||||
(t element)))
|
||||
|
||||
(defsubst org-element-set-contents (element &rest contents)
|
||||
"Set ELEMENT's contents to CONTENTS.
|
||||
Return ELEMENT."
|
||||
(cond ((null element) contents)
|
||||
((not (symbolp (car element)))
|
||||
(if (not (listp element))
|
||||
;; Non-element.
|
||||
contents
|
||||
;; Anonymous element (el1 el2 ...)
|
||||
(setcar element (car contents))
|
||||
(setcdr element (cdr contents))
|
||||
element))
|
||||
((cdr element) (setcdr (cdr element) contents) element)
|
||||
(t (nconc element contents))))
|
||||
|
||||
(defsubst org-element-adopt-elements (parent &rest children)
|
||||
"Append elements to the contents of another element.
|
||||
|
||||
PARENT is an element or object. CHILDREN can be elements,
|
||||
objects, or a strings.
|
||||
|
||||
The function takes care of setting `:parent' property for CHILD.
|
||||
Return parent element."
|
||||
(declare (indent 1))
|
||||
(if (not children) parent
|
||||
;; Link every child to PARENT. If PARENT is nil, it is a secondary
|
||||
;; string: parent is the list itself.
|
||||
(dolist (child children)
|
||||
(when child
|
||||
(org-element-put-property child :parent (or parent children))))
|
||||
;; Add CHILDREN at the end of PARENT contents.
|
||||
(when parent
|
||||
(apply #'org-element-set-contents
|
||||
parent
|
||||
(nconc (org-element-contents parent) children)))
|
||||
;; Return modified PARENT element.
|
||||
(or parent children)))
|
||||
|
||||
(defun org-element-extract-element (element)
|
||||
"Extract ELEMENT from parse tree.
|
||||
Remove element from the parse tree by side-effect, and return it
|
||||
with its `:parent' property stripped out."
|
||||
(let ((parent (org-element-property :parent element))
|
||||
(secondary (org-element-secondary-p element)))
|
||||
(if secondary
|
||||
(org-element-put-property
|
||||
parent secondary
|
||||
(delq element (org-element-property secondary parent)))
|
||||
(apply #'org-element-set-contents
|
||||
parent
|
||||
(delq element (org-element-contents parent))))
|
||||
;; 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)))
|
||||
;; Special case: LOCATION is the first element of an
|
||||
;; independent secondary string (e.g. :title property). Add
|
||||
;; ELEMENT in-place.
|
||||
(specialp (and (not property)
|
||||
(eq siblings parent)
|
||||
(eq (car parent) location))))
|
||||
;; Install ELEMENT at the appropriate LOCATION within SIBLINGS.
|
||||
(cond (specialp)
|
||||
((or (null siblings) (eq (car siblings) location))
|
||||
(push element siblings))
|
||||
((null location) (nconc siblings (list element)))
|
||||
(t
|
||||
(let ((index (cl-position location siblings)))
|
||||
(unless index (error "No location found to insert element"))
|
||||
(push element (cdr (nthcdr (1- index) siblings))))))
|
||||
;; Store SIBLINGS at appropriate place in parse tree.
|
||||
(cond
|
||||
(specialp (setcdr parent (copy-sequence parent)) (setcar parent element))
|
||||
(property (org-element-put-property parent property siblings))
|
||||
(t (apply #'org-element-set-contents parent siblings)))
|
||||
;; 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))
|
||||
(dolist (p org-element--cache-element-properties)
|
||||
(when (org-element-property p old)
|
||||
(org-element-put-property new p (org-element-property p 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))))
|
||||
|
||||
(defun org-element-create (type &optional props &rest children)
|
||||
"Create a new element of type TYPE.
|
||||
Optional argument PROPS, when non-nil, is a plist defining the
|
||||
properties of the element. CHILDREN can be elements, objects or
|
||||
strings."
|
||||
(apply #'org-element-adopt-elements (list type props) children))
|
||||
|
||||
(defun org-element-copy (datum)
|
||||
"Return a copy of DATUM.
|
||||
DATUM is an element, object, string or nil. `:parent' property
|
||||
is cleared and contents are removed in the process."
|
||||
(when datum
|
||||
(let ((type (org-element-type datum)))
|
||||
(pcase type
|
||||
(`org-data (list 'org-data nil))
|
||||
(`plain-text (substring-no-properties datum))
|
||||
(`nil (copy-sequence datum))
|
||||
(_
|
||||
(let ((element-copy (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil))))
|
||||
;; We cannot simply return the copies property list. When
|
||||
;; DATUM is i.e. a headline, it's property list (`:title'
|
||||
;; in case of headline) can contain parsed objects. The
|
||||
;; objects will contain `:parent' property set to the DATUM
|
||||
;; itself. When copied, these inner `:parent' property
|
||||
;; values will contain incorrect object decoupled from
|
||||
;; DATUM. Changes to the DATUM copy will not longer be
|
||||
;; reflected in the `:parent' properties. So, we need to
|
||||
;; reassign inner `:parent' properties to the DATUM copy
|
||||
;; explicitly.
|
||||
(org-element-map element-copy (cons 'plain-text org-element-all-objects)
|
||||
(lambda (obj) (when (equal datum (org-element-property :parent obj))
|
||||
(org-element-put-property obj :parent element-copy))))
|
||||
element-copy))))))
|
||||
|
||||
(defun org-element-lineage (datum &optional types with-self)
|
||||
"List all ancestors of a given element or object.
|
||||
|
||||
DATUM is an object or element.
|
||||
|
||||
Return ancestors from the closest to the farthest. When optional
|
||||
argument TYPES is a list of symbols, return the first element or
|
||||
object in the lineage whose type belongs to that list instead.
|
||||
|
||||
When optional argument WITH-SELF is non-nil, lineage includes
|
||||
DATUM itself as the first element, and TYPES, if provided, also
|
||||
apply to it.
|
||||
|
||||
When DATUM is obtained through `org-element-context' or
|
||||
`org-element-at-point', only ancestors from its section can be
|
||||
found. There is no such limitation when DATUM belongs to a full
|
||||
parse tree."
|
||||
(let ((up (if with-self datum (org-element-property :parent datum)))
|
||||
ancestors)
|
||||
(while (and up (not (memq (org-element-type up) types)))
|
||||
(unless types (push up ancestors))
|
||||
(setq up (org-element-property :parent up)))
|
||||
(if types up (nreverse ancestors))))
|
Loading…
Reference in New Issue