From ceaeb33629c98562bd942f0bb7b0f8067f97d0ce Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 15 Jul 2012 12:25:01 +0200 Subject: [PATCH] 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 | 228 +++++++++++++++--------------------- 1 file changed, 96 insertions(+), 132 deletions(-) diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el index caa8907d2..c06bb44f8 100644 --- a/contrib/lisp/org-element.el +++ b/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." - (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. - (when (consp child) (org-element-put-property child :parent parent)) - ;; Return the parent element. - parent) + (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. + (when (consp child) (org-element-put-property child :parent parent)) + ;; Return the parent element. + 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 -that will be looked after." +RESTRICTION is a symbol limiting the object types that will be +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,58 +3595,40 @@ 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 - acc - (list - (cond - ;; Case 1. Simply accumulate element if VISIBLE-ONLY is - ;; true and element is hidden or if it has no contents - ;; anyway. - ((or (and visible-only (org-element-property :hiddenp element)) - (not cbeg)) element) - ;; Case 2. Greater element: parse it between - ;; `contents-begin' and `contents-end'. Make sure - ;; GRANULARITY allows the recursion, or ELEMENT is an - ;; headline, in which case going inside is mandatory, in - ;; order to get sub-level headings. - ((and (memq type org-element-greater-elements) - (or (memq granularity '(element object nil)) - (and (eq granularity 'greater-element) - (eq type 'section)) - (eq type 'headline))) - (org-element-parse-elements - cbeg (org-element-property :contents-end element) - ;; Possibly switch to a special mode. - (case type - (headline - (if (org-element-property :quotedp element) 'quote-section - 'section)) - (plain-list 'item) - (table 'table-row)) - (org-element-property :structure element) - granularity visible-only element)) - ;; Case 3. ELEMENT has contents. Parse objects inside, - ;; if GRANULARITY allows it. - ((and cbeg (memq granularity '(object nil))) - (org-element-parse-objects - cbeg (org-element-property :contents-end element) - element (org-element-restriction type))) - ;; Case 4. Else, just accumulate ELEMENT. - (t element)))))) + ;; Fill ELEMENT contents by side-effect. + (cond + ;; If VISIBLE-ONLY is true and element is hidden or if it has + ;; no contents, don't modify it. + ((or (and visible-only (org-element-property :hiddenp element)) + (not cbeg))) + ;; Greater element: parse it between `contents-begin' and + ;; `contents-end'. Make sure GRANULARITY allows the + ;; recursion, or ELEMENT is an headline, in which case going + ;; inside is mandatory, in order to get sub-level headings. + ((and (memq type org-element-greater-elements) + (or (memq granularity '(element object nil)) + (and (eq granularity 'greater-element) + (eq type 'section)) + (eq type 'headline))) + (org-element-parse-elements + cbeg (org-element-property :contents-end element) + ;; Possibly switch to a special mode. + (case type + (headline + (if (org-element-property :quotedp element) 'quote-section + 'section)) + (plain-list 'item) + (table 'table-row)) + (org-element-property :structure element) + granularity visible-only element)) + ;; ELEMENT has contents. Parse objects inside, if + ;; GRANULARITY allows it. + ((memq granularity '(object nil)) + (org-element-parse-objects + cbeg (org-element-property :contents-end element) element + (org-element-restriction type)))) + (org-element-adopt-element acc element t))) ;; 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 - (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) + (let (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)) - ;; Set ACC as parent of current element. It will be completed - ;; by side-effect. - (plist-put (nth 1 next-object) :parent acc) - ;; 1. Text before any object. Untabify it. - (let ((obj-beg (org-element-property :begin next-object))) - (unless (= (point) obj-beg) - (let ((beg-text - (list - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) obj-beg))))) - (if acc (nconc acc beg-text) (setq acc beg-text))))) - ;; 2. Object... - (let* ((obj-end (org-element-property :end next-object)) - (cont-beg (org-element-property :contents-begin next-object)) - (complete-next-object - (if (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))) - next-object))) - (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))) + (let ((next-object + (let ((pos (apply 'min (mapcar 'cdr candidates)))) + (save-excursion + (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) + (setq acc + (org-element-adopt-element + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) obj-beg)) t)))) + ;; 2. Object... + (let ((obj-end (org-element-property :end next-object)) + (cont-beg (org-element-property :contents-begin next-object))) + ;; Fill contents of NEXT-OBJECT by side-effect, if it has + ;; a recursive type. + (when (and (memq (car next-object) org-element-recursive-objects) + cont-beg) + (save-restriction + (narrow-to-region + cont-beg + (org-element-property :contents-end next-object)) + (org-element-parse-objects + (point-min) (point-max) next-object + (org-element-restriction next-object)))) + (setq acc (org-element-adopt-element acc next-object t)) + (goto-char obj-end)))) ;; 3. Text after last object. Untabify it. (unless (= (point) end) - (let ((end-text - (list - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) end))))) - (if acc (nconc acc end-text) (setq acc end-text)))) + (setq acc + (org-element-adopt-element + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) end)) t))) ;; Result. acc)))