org-element: Handle special cases in setter functions
* contrib/lisp/org-element.el (org-element-put-property, org-element-set-contents): Handle special cases like empty or string arguments. (org-element-parse-secondary-string): Correctly set `:parent' property in objects within the secondary string if element or object containing it is provided as an optional argument. (org-element-parse-elements, org-element-parse-objects): Rewrite functions using setter functions.
This commit is contained in:
Nicolas Goaziou
parent
6762c7ea60
commit
ceaeb33629
|
|
@ -3100,13 +3100,16 @@ element or object type."
|
||||||
(defsubst org-element-put-property (element property value)
|
(defsubst org-element-put-property (element property value)
|
||||||
"In ELEMENT set PROPERTY to VALUE.
|
"In ELEMENT set PROPERTY to VALUE.
|
||||||
Return modified element."
|
Return modified element."
|
||||||
(setcar (cdr element) (plist-put (nth 1 element) property value))
|
(when (consp element)
|
||||||
|
(setcar (cdr element) (plist-put (nth 1 element) property value)))
|
||||||
element)
|
element)
|
||||||
|
|
||||||
(defsubst org-element-set-contents (element &rest contents)
|
(defsubst org-element-set-contents (element &rest contents)
|
||||||
"Set ELEMENT contents to CONTENTS.
|
"Set ELEMENT contents to CONTENTS.
|
||||||
Return modified element."
|
Return modified element."
|
||||||
(setcdr (cdr element) contents))
|
(cond ((not element) (list contents))
|
||||||
|
((cdr element) (setcdr (cdr element) contents))
|
||||||
|
(t (nconc element contents))))
|
||||||
|
|
||||||
(defsubst org-element-set-element (old new)
|
(defsubst org-element-set-element (old new)
|
||||||
"Replace element or object OLD with element or object NEW.
|
"Replace element or object OLD with element or object NEW.
|
||||||
|
|
@ -3135,14 +3138,15 @@ at the end.
|
||||||
|
|
||||||
The function takes care of setting `:parent' property for CHILD.
|
The function takes care of setting `:parent' property for CHILD.
|
||||||
Return parent element."
|
Return parent element."
|
||||||
(let ((contents (org-element-contents parent)))
|
(if (not parent) (list child)
|
||||||
(apply 'org-element-set-contents
|
(let ((contents (org-element-contents parent)))
|
||||||
parent
|
(apply 'org-element-set-contents
|
||||||
(if append (append contents (list child)) (cons child contents))))
|
parent
|
||||||
;; Link the child element with parent.
|
(if append (append contents (list child)) (cons child contents))))
|
||||||
(when (consp child) (org-element-put-property child :parent parent))
|
;; Link the CHILD element with PARENT.
|
||||||
;; Return the parent element.
|
(when (consp child) (org-element-put-property child :parent parent))
|
||||||
parent)
|
;; Return the parent element.
|
||||||
|
parent))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -3430,14 +3434,21 @@ Assume buffer is in Org mode."
|
||||||
;; headline belongs to a section.
|
;; headline belongs to a section.
|
||||||
'section nil granularity visible-only (list 'org-data nil))))
|
'section nil granularity visible-only (list 'org-data nil))))
|
||||||
|
|
||||||
(defun org-element-parse-secondary-string (string restriction)
|
(defun org-element-parse-secondary-string (string restriction &optional parent)
|
||||||
"Recursively parse objects in STRING and return structure.
|
"Recursively parse objects in STRING and return structure.
|
||||||
|
|
||||||
RESTRICTION, when non-nil, is a symbol limiting the object types
|
RESTRICTION is a symbol limiting the object types that will be
|
||||||
that will be looked after."
|
looked after.
|
||||||
|
|
||||||
|
Optional argument PARENT, when non-nil, is the element or object
|
||||||
|
containing the secondary string. It is used to set correctly
|
||||||
|
`:parent' property within the string."
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(insert string)
|
(insert string)
|
||||||
(org-element-parse-objects (point-min) (point-max) nil restriction)))
|
(let ((secondary (org-element-parse-objects
|
||||||
|
(point-min) (point-max) nil restriction)))
|
||||||
|
(mapc (lambda (obj) (org-element-put-property obj :parent parent))
|
||||||
|
secondary))))
|
||||||
|
|
||||||
(defun org-element-map (data types fun &optional info first-match no-recursion)
|
(defun org-element-map (data types fun &optional info first-match no-recursion)
|
||||||
"Map a function on selected elements or objects.
|
"Map a function on selected elements or objects.
|
||||||
|
|
@ -3584,58 +3595,40 @@ Elements are accumulated into ACC."
|
||||||
end granularity special structure))
|
end granularity special structure))
|
||||||
(type (org-element-type element))
|
(type (org-element-type element))
|
||||||
(cbeg (org-element-property :contents-begin element)))
|
(cbeg (org-element-property :contents-begin element)))
|
||||||
;; Set ACC as parent of current element. It will be
|
|
||||||
;; completed by side-effect. If the element contains any
|
|
||||||
;; secondary string, also set `:parent' property of every
|
|
||||||
;; object within it as current element.
|
|
||||||
(plist-put (nth 1 element) :parent acc)
|
|
||||||
(let ((sec-loc (assq type org-element-secondary-value-alist)))
|
|
||||||
(when sec-loc
|
|
||||||
(let ((sec-value (org-element-property (cdr sec-loc) element)))
|
|
||||||
(unless (stringp sec-value)
|
|
||||||
(mapc (lambda (obj)
|
|
||||||
(unless (stringp obj)
|
|
||||||
(plist-put (nth 1 obj) :parent element)))
|
|
||||||
sec-value)))))
|
|
||||||
(goto-char (org-element-property :end element))
|
(goto-char (org-element-property :end element))
|
||||||
(nconc
|
;; Fill ELEMENT contents by side-effect.
|
||||||
acc
|
(cond
|
||||||
(list
|
;; If VISIBLE-ONLY is true and element is hidden or if it has
|
||||||
(cond
|
;; no contents, don't modify it.
|
||||||
;; Case 1. Simply accumulate element if VISIBLE-ONLY is
|
((or (and visible-only (org-element-property :hiddenp element))
|
||||||
;; true and element is hidden or if it has no contents
|
(not cbeg)))
|
||||||
;; anyway.
|
;; Greater element: parse it between `contents-begin' and
|
||||||
((or (and visible-only (org-element-property :hiddenp element))
|
;; `contents-end'. Make sure GRANULARITY allows the
|
||||||
(not cbeg)) element)
|
;; recursion, or ELEMENT is an headline, in which case going
|
||||||
;; Case 2. Greater element: parse it between
|
;; inside is mandatory, in order to get sub-level headings.
|
||||||
;; `contents-begin' and `contents-end'. Make sure
|
((and (memq type org-element-greater-elements)
|
||||||
;; GRANULARITY allows the recursion, or ELEMENT is an
|
(or (memq granularity '(element object nil))
|
||||||
;; headline, in which case going inside is mandatory, in
|
(and (eq granularity 'greater-element)
|
||||||
;; order to get sub-level headings.
|
(eq type 'section))
|
||||||
((and (memq type org-element-greater-elements)
|
(eq type 'headline)))
|
||||||
(or (memq granularity '(element object nil))
|
(org-element-parse-elements
|
||||||
(and (eq granularity 'greater-element)
|
cbeg (org-element-property :contents-end element)
|
||||||
(eq type 'section))
|
;; Possibly switch to a special mode.
|
||||||
(eq type 'headline)))
|
(case type
|
||||||
(org-element-parse-elements
|
(headline
|
||||||
cbeg (org-element-property :contents-end element)
|
(if (org-element-property :quotedp element) 'quote-section
|
||||||
;; Possibly switch to a special mode.
|
'section))
|
||||||
(case type
|
(plain-list 'item)
|
||||||
(headline
|
(table 'table-row))
|
||||||
(if (org-element-property :quotedp element) 'quote-section
|
(org-element-property :structure element)
|
||||||
'section))
|
granularity visible-only element))
|
||||||
(plain-list 'item)
|
;; ELEMENT has contents. Parse objects inside, if
|
||||||
(table 'table-row))
|
;; GRANULARITY allows it.
|
||||||
(org-element-property :structure element)
|
((memq granularity '(object nil))
|
||||||
granularity visible-only element))
|
(org-element-parse-objects
|
||||||
;; Case 3. ELEMENT has contents. Parse objects inside,
|
cbeg (org-element-property :contents-end element) element
|
||||||
;; if GRANULARITY allows it.
|
(org-element-restriction type))))
|
||||||
((and cbeg (memq granularity '(object nil)))
|
(org-element-adopt-element acc element t)))
|
||||||
(org-element-parse-objects
|
|
||||||
cbeg (org-element-property :contents-end element)
|
|
||||||
element (org-element-restriction type)))
|
|
||||||
;; Case 4. Else, just accumulate ELEMENT.
|
|
||||||
(t element))))))
|
|
||||||
;; Return result.
|
;; Return result.
|
||||||
acc))
|
acc))
|
||||||
|
|
||||||
|
|
@ -3646,79 +3639,50 @@ Objects are accumulated in ACC.
|
||||||
|
|
||||||
RESTRICTION is a list of object types which are allowed in the
|
RESTRICTION is a list of object types which are allowed in the
|
||||||
current object."
|
current object."
|
||||||
(let ((get-next-object
|
(let (candidates)
|
||||||
(function
|
|
||||||
(lambda (cand)
|
|
||||||
;; Return the parsing function associated to the nearest
|
|
||||||
;; object among list of candidates CAND.
|
|
||||||
(let ((pos (apply 'min (mapcar 'cdr cand))))
|
|
||||||
(save-excursion
|
|
||||||
(goto-char pos)
|
|
||||||
(funcall
|
|
||||||
(intern
|
|
||||||
(format "org-element-%s-parser" (car (rassq pos cand))))))))))
|
|
||||||
next-object candidates)
|
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char beg)
|
(goto-char beg)
|
||||||
(while (setq candidates (org-element-get-next-object-candidates
|
(while (setq candidates (org-element-get-next-object-candidates
|
||||||
end restriction candidates))
|
end restriction candidates))
|
||||||
(setq next-object (funcall get-next-object candidates))
|
(let ((next-object
|
||||||
;; Set ACC as parent of current element. It will be completed
|
(let ((pos (apply 'min (mapcar 'cdr candidates))))
|
||||||
;; by side-effect.
|
(save-excursion
|
||||||
(plist-put (nth 1 next-object) :parent acc)
|
(goto-char pos)
|
||||||
;; 1. Text before any object. Untabify it.
|
(funcall (intern (format "org-element-%s-parser"
|
||||||
(let ((obj-beg (org-element-property :begin next-object)))
|
(car (rassq pos candidates)))))))))
|
||||||
(unless (= (point) obj-beg)
|
;; 1. Text before any object. Untabify it.
|
||||||
(let ((beg-text
|
(let ((obj-beg (org-element-property :begin next-object)))
|
||||||
(list
|
(unless (= (point) obj-beg)
|
||||||
(replace-regexp-in-string
|
(setq acc
|
||||||
"\t" (make-string tab-width ? )
|
(org-element-adopt-element
|
||||||
(buffer-substring-no-properties (point) obj-beg)))))
|
acc
|
||||||
(if acc (nconc acc beg-text) (setq acc beg-text)))))
|
(replace-regexp-in-string
|
||||||
;; 2. Object...
|
"\t" (make-string tab-width ? )
|
||||||
(let* ((obj-end (org-element-property :end next-object))
|
(buffer-substring-no-properties (point) obj-beg)) t))))
|
||||||
(cont-beg (org-element-property :contents-begin next-object))
|
;; 2. Object...
|
||||||
(complete-next-object
|
(let ((obj-end (org-element-property :end next-object))
|
||||||
(if (and (memq (car next-object) org-element-recursive-objects)
|
(cont-beg (org-element-property :contents-begin next-object)))
|
||||||
cont-beg)
|
;; Fill contents of NEXT-OBJECT by side-effect, if it has
|
||||||
;; ... recursive. The CONT-BEG check is for
|
;; a recursive type.
|
||||||
;; links, as some of them might not be recursive
|
(when (and (memq (car next-object) org-element-recursive-objects)
|
||||||
;; (i.e. plain links).
|
cont-beg)
|
||||||
(save-restriction
|
(save-restriction
|
||||||
(narrow-to-region
|
(narrow-to-region
|
||||||
cont-beg
|
cont-beg
|
||||||
(org-element-property :contents-end next-object))
|
(org-element-property :contents-end next-object))
|
||||||
(org-element-parse-objects
|
(org-element-parse-objects
|
||||||
(point-min) (point-max) next-object
|
(point-min) (point-max) next-object
|
||||||
;; Restrict allowed objects.
|
(org-element-restriction next-object))))
|
||||||
(org-element-restriction next-object)))
|
(setq acc (org-element-adopt-element acc next-object t))
|
||||||
next-object)))
|
(goto-char obj-end))))
|
||||||
(if acc (nconc acc (list complete-next-object))
|
|
||||||
(setq acc (list complete-next-object)))
|
|
||||||
;; If the object contains any secondary string, also set
|
|
||||||
;; `:parent' property of every object within it as current
|
|
||||||
;; object.
|
|
||||||
(let ((sec-loc (assq (org-element-type next-object)
|
|
||||||
org-element-secondary-value-alist)))
|
|
||||||
(when sec-loc
|
|
||||||
(let ((sec-value
|
|
||||||
(org-element-property (cdr sec-loc) next-object)))
|
|
||||||
(unless (stringp sec-value)
|
|
||||||
(mapc (lambda (obj)
|
|
||||||
(unless (stringp obj)
|
|
||||||
(plist-put (nth 1 obj)
|
|
||||||
:parent
|
|
||||||
complete-next-object)))
|
|
||||||
sec-value)))))
|
|
||||||
(goto-char obj-end)))
|
|
||||||
;; 3. Text after last object. Untabify it.
|
;; 3. Text after last object. Untabify it.
|
||||||
(unless (= (point) end)
|
(unless (= (point) end)
|
||||||
(let ((end-text
|
(setq acc
|
||||||
(list
|
(org-element-adopt-element
|
||||||
(replace-regexp-in-string
|
acc
|
||||||
"\t" (make-string tab-width ? )
|
(replace-regexp-in-string
|
||||||
(buffer-substring-no-properties (point) end)))))
|
"\t" (make-string tab-width ? )
|
||||||
(if acc (nconc acc end-text) (setq acc end-text))))
|
(buffer-substring-no-properties (point) end)) t)))
|
||||||
;; Result.
|
;; Result.
|
||||||
acc)))
|
acc)))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue