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.

contrib/lisp/org-element.el

@@ -3100,13 +3100,16 @@ element or object type."
 (defsubst org-element-put-property (element property value)
   "In ELEMENT set PROPERTY to VALUE.
 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)
 
 (defsubst org-element-set-contents (element &rest contents)
   "Set ELEMENT contents to CONTENTS.
 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)
   "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.
 Return parent element."
+  (if (not parent) (list child)
     (let ((contents (org-element-contents parent)))
       (apply 'org-element-set-contents
 	     parent
 	     (if append (append contents (list child)) (cons child contents))))
-  ;; Link the child element with parent.
+    ;; Link the CHILD element with PARENT.
     (when (consp child) (org-element-put-property child :parent parent))
     ;; Return the parent element.
-  parent)
+    parent))
 
 
 
@@ -3430,14 +3434,21 @@ Assume buffer is in Org mode."
      ;; headline belongs to a section.
      '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.
 
-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
     (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)
   "Map a function on selected elements or objects.
@@ -3584,34 +3595,17 @@ Elements are accumulated into ACC."
 		       end granularity special structure))
 	     (type (org-element-type 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))
-	(nconc
+	;; Fill ELEMENT contents by side-effect.
-	 acc
-	 (list
 	(cond
-	   ;; Case 1.  Simply accumulate element if VISIBLE-ONLY is
+	 ;; If VISIBLE-ONLY is true and element is hidden or if it has
-	   ;; true and element is hidden or if it has no contents
+	 ;; no contents, don't modify it.
-	   ;; anyway.
 	 ((or (and visible-only (org-element-property :hiddenp element))
-		(not cbeg)) element)
+	      (not cbeg)))
-	   ;; Case 2.  Greater element: parse it between
+	 ;; Greater element: parse it between `contents-begin' and
-	   ;; `contents-begin' and `contents-end'.  Make sure
+	 ;; `contents-end'.  Make sure GRANULARITY allows the
-	   ;; GRANULARITY allows the recursion, or ELEMENT is an
+	 ;; recursion, or ELEMENT is an headline, in which case going
-	   ;; headline, in which case going inside is mandatory, in
+	 ;; inside is mandatory, in order to get sub-level headings.
-	   ;; order to get sub-level headings.
 	 ((and (memq type org-element-greater-elements)
 	       (or (memq granularity '(element object nil))
 		   (and (eq granularity 'greater-element)
@@ -3628,14 +3622,13 @@ Elements are accumulated into ACC."
 	     (table 'table-row))
 	   (org-element-property :structure element)
 	   granularity visible-only element))
-	   ;; Case 3.  ELEMENT has contents.  Parse objects inside,
+	 ;; ELEMENT has contents.  Parse objects inside, if
-	   ;; if GRANULARITY allows it.
+	 ;; GRANULARITY allows it.
-	   ((and cbeg (memq granularity '(object nil)))
+	 ((memq granularity '(object nil))
 	  (org-element-parse-objects
-	     cbeg (org-element-property :contents-end element)
+	   cbeg (org-element-property :contents-end element) element
-	     element (org-element-restriction type)))
+	   (org-element-restriction type))))
-	   ;; Case 4.  Else, just accumulate ELEMENT.
+	(org-element-adopt-element acc element t)))
-	   (t element))))))
     ;; Return result.
     acc))
 
@@ -3646,79 +3639,50 @@ Objects are accumulated in ACC.
 
 RESTRICTION is a list of object types which are allowed in the
 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
       (goto-char beg)
       (while (setq candidates (org-element-get-next-object-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)
+		   (funcall (intern (format "org-element-%s-parser"
+					    (car (rassq pos candidates)))))))))
 	  ;; 1. Text before any object.  Untabify it.
 	  (let ((obj-beg (org-element-property :begin next-object)))
 	    (unless (= (point) obj-beg)
-	    (let ((beg-text
+	      (setq acc
-		   (list
+		    (org-element-adopt-element
+		     acc
 		     (replace-regexp-in-string
 		      "\t" (make-string tab-width ? )
-		     (buffer-substring-no-properties (point) obj-beg)))))
+		      (buffer-substring-no-properties (point) obj-beg)) t))))
-	      (if acc (nconc acc beg-text) (setq acc beg-text)))))
 	  ;; 2. Object...
-	(let* ((obj-end (org-element-property :end next-object))
+	  (let ((obj-end (org-element-property :end next-object))
-	       (cont-beg (org-element-property :contents-begin next-object))
+		(cont-beg (org-element-property :contents-begin next-object)))
-	       (complete-next-object
+	    ;; Fill contents of NEXT-OBJECT by side-effect, if it has
-		(if (and (memq (car next-object) org-element-recursive-objects)
+	    ;; a recursive type.
+	    (when (and (memq (car next-object) org-element-recursive-objects)
 		       cont-beg)
-		    ;; ... recursive.  The CONT-BEG check is for
-		    ;; links, as some of them might not be recursive
-		    ;; (i.e. plain links).
 	      (save-restriction
 		(narrow-to-region
 		 cont-beg
 		 (org-element-property :contents-end next-object))
 		(org-element-parse-objects
 		 (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.
       (unless (= (point) end)
-	(let ((end-text
+	(setq acc
-	       (list
+	      (org-element-adopt-element
+	       acc
 	       (replace-regexp-in-string
 		"\t" (make-string tab-width ? )
-		 (buffer-substring-no-properties (point) end)))))
+		(buffer-substring-no-properties (point) end)) t)))
-	  (if acc (nconc acc end-text) (setq acc end-text))))
       ;; Result.
       acc)))