org-element: Improve support for pseudo objects and elements

* lisp/org-element.el (org-element-class): New function.
(org-element-map):
(org-element-interpret-data):
* lisp/org-footnote.el (org-footnote--allow-reference-p):
* lisp/org-src.el (org-src--on-datum-p):
* lisp/ox-odt.el (org-odt-footnote-reference):
(org-odt-table-cell):
* lisp/ox.el (org-export-data):
(org-export-expand): Use new function.

* testing/lisp/test-org-element.el (test-org-element/class): New test.

Using generic `org-element-class' allows to handle unknown, i.e.,
pseudo, object or element types.  It also reduces code duplication in
`org-element-interpret-data' and `org-export-data', preventing, e.g.,
bugs as the one fixed in c58e1b5.
This commit is contained in:
Nicolas Goaziou 2016-10-25 13:13:26 +02:00
parent dd670073de
commit 1a88cf920e
6 changed files with 67 additions and 33 deletions

View File

@ -455,8 +455,10 @@ past the brackets."
;; 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. `org-element-copy' returns
;; an element or object, stripping its parent property in the process.
;; object belongs to a secondary string. `org-element-class' tells if
;; some parsed data is an element or an object, handling pseudo
;; elements and objects. `org-element-copy' returns an element or
;; object, stripping its parent property in the process.
(defsubst org-element-type (element)
"Return type of ELEMENT.
@ -514,6 +516,31 @@ Return value is the property name, as a keyword, or nil."
(and (memq object (org-element-property p parent))
(throw 'exit p))))))
(defun org-element-class (datum &optional parent)
"Return class for ELEMENT, as a symbol.
Class is either `element' or `object'. Optional argument PARENT
is the element or object containing DATUM. It defaults to the
value of DATUM `:parent' property."
(let ((type (org-element-type datum))
(parent (or parent (org-element-property :parent datum))))
(cond
;; Trivial cases.
((memq type org-element-all-objects) 'object)
((memq type org-element-all-elements) 'element)
;; Special cases.
((eq type 'org-data) 'element)
((eq type 'plain-text) 'object)
((not type) 'object)
;; Pseudo object or elements. Make a guess about its class.
;; Basically a pseudo object is contained within another object,
;; a secondary string or a container element.
((not parent) 'element)
(t
(let ((parent-type (org-element-type parent)))
(cond ((not parent-type) 'object)
((memq parent-type org-element-object-containers) 'object)
(t 'element)))))))
(defsubst org-element-adopt-elements (parent &rest children)
"Append elements to the contents of another element.
@ -4179,7 +4206,7 @@ looking into captions:
;; them.
(when (and with-affiliated
(eq --category 'objects)
(memq --type org-element-all-elements))
(eq (org-element-class --data) 'element))
(dolist (kwd-pair org-element--parsed-properties-alist)
(let ((kwd (car kwd-pair))
(value (org-element-property (cdr kwd-pair) --data)))
@ -4210,7 +4237,7 @@ looking into captions:
(not (memq --type org-element-greater-elements))))
;; Looking for elements but --DATA is an object.
((and (eq --category 'elements)
(memq --type org-element-all-objects)))
(eq (org-element-class --data) 'object)))
;; In any other case, map contents.
(t (mapc --walk-tree (org-element-contents --data))))))))))
(catch :--map-first-match
@ -4533,19 +4560,13 @@ to interpret. Return Org syntax as a string."
(if (memq type '(org-data plain-text nil)) results
;; Build white spaces. If no `:post-blank' property
;; is specified, assume its value is 0.
(let ((blank (or (org-element-property :post-blank data) 0)))
(if (or (memq type org-element-all-objects)
(and (not (memq type org-element-all-elements))
parent
(let ((type (org-element-type parent)))
(or (not type)
(memq type
org-element-object-containers)))))
(let ((blank (or (org-element-property :post-blank data) 0))
(class (org-element-class data parent)))
(if (eq class 'object)
(concat results (make-string blank ?\s))
(concat
(org-element--interpret-affiliated-keywords data)
(org-element-normalize-string results)
(make-string blank ?\n)))))))))
(concat (org-element--interpret-affiliated-keywords data)
(org-element-normalize-string results)
(make-string blank ?\n)))))))))
(funcall fun data nil)))
(defun org-element--interpret-affiliated-keywords (element)

View File

@ -39,6 +39,7 @@
(declare-function org-back-over-empty-lines "org" ())
(declare-function org-edit-footnote-reference "org-src" ())
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-class "org-element" (datum &optional parent))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-lineage "org-element" (blob &optional types with-self))
(declare-function org-element-property "org-element" (property element))
@ -59,8 +60,6 @@
(defvar org-blank-before-new-entry) ; defined in org.el
(defvar org-bracket-link-regexp) ; defined in org.el
(defvar org-complex-heading-regexp) ; defined in org.el
(defvar org-element-all-elements) ; defined in org-element.el
(defvar org-element-all-objects) ; defined in org-element.el
(defvar org-odd-levels-only) ; defined in org.el
(defvar org-outline-regexp) ; defined in org.el
(defvar org-outline-regexp-bol) ; defined in org.el
@ -298,10 +297,10 @@ otherwise."
((>= (point)
(save-excursion (goto-char (org-element-property :end context))
(skip-chars-backward " \r\t\n")
(if (memq type org-element-all-objects) (point)
(if (eq (org-element-class context) 'object) (point)
(1+ (line-beginning-position 2))))))
;; Other elements are invalid.
((memq type org-element-all-elements) nil)
((eq (org-element-class context) 'element) nil)
;; Just before object is fine.
((= (point) (org-element-property :begin context)))
;; Within recursive object too, but not in a link.

View File

@ -380,7 +380,7 @@ spaces after it as being outside."
(org-with-wide-buffer
(goto-char (org-element-property :end datum))
(skip-chars-backward " \r\t\n")
(if (memq (org-element-type datum) org-element-all-elements)
(if (eq (org-element-class datum) 'element)
(line-end-position)
(point))))))

View File

@ -1747,8 +1747,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
info))))
;; Inline definitions are secondary strings. We
;; need to wrap them within a paragraph.
(if (memq (org-element-type (car (org-element-contents raw)))
org-element-all-elements)
(if (eq (org-element-class (car (org-element-contents raw)))
'element)
def
(format
"\n<text:p text:style-name=\"Footnote\">%s</text:p>"
@ -3334,8 +3334,7 @@ channel."
(format "\n<table:table-cell%s>\n%s\n</table:table-cell>"
cell-attributes
(let ((table-cell-contents (org-element-contents table-cell)))
(if (memq (org-element-type (car table-cell-contents))
org-element-all-elements)
(if (eq (org-element-class (car table-cell-contents)) 'element)
contents
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
paragraph-style contents))))

View File

@ -1988,13 +1988,9 @@ Return a string."
(t
(org-export-filter-apply-functions
(plist-get info (intern (format ":filter-%s" type)))
(let ((blank (or (org-element-property :post-blank data) 0)))
(if (or (memq type org-element-all-objects)
(and (not (memq type org-element-all-elements))
parent
(let ((type (org-element-type parent)))
(or (not type)
(memq type org-element-object-containers)))))
(let ((blank (or (org-element-property :post-blank data) 0))
(class (org-element-class data parent)))
(if (eq class 'object)
(concat results (make-string blank ?\s))
(concat (org-element-normalize-string results)
(make-string blank ?\n))))
@ -2033,7 +2029,8 @@ contents, as a string or nil.
When optional argument WITH-AFFILIATED is non-nil, add affiliated
keywords before output."
(let ((type (org-element-type blob)))
(concat (and with-affiliated (memq type org-element-all-elements)
(concat (and with-affiliated
(eq (org-element-class blob) 'element)
(org-element--interpret-affiliated-keywords blob))
(funcall (intern (format "org-element-%s-interpreter" type))
blob contents))))

View File

@ -140,6 +140,24 @@ Some other text
(lambda (object) (org-element-type (org-element-secondary-p object)))
nil t))))
(ert-deftest test-org-element/class ()
"Test `org-element-class' specifications."
;; Regular tests.
(should (eq 'element (org-element-class '(paragraph nil) nil)))
(should (eq 'object (org-element-class '(target nil) nil)))
;; Special types.
(should (eq 'element (org-element-class '(org-data nil) nil)))
(should (eq 'object (org-element-class "text" nil)))
(should (eq 'object (org-element-class '("secondary " "string") nil)))
;; Pseudo elements.
(should (eq 'element (org-element-class '(foo nil) nil)))
(should (eq 'element (org-element-class '(foo nil) '(center-block nil))))
(should (eq 'element (org-element-class '(foo nil) '(org-data nil))))
;; Pseudo objects.
(should (eq 'object (org-element-class '(foo nil) '(bold nil))))
(should (eq 'object (org-element-class '(foo nil) '(paragraph nil))))
(should (eq 'object (org-element-class '(foo nil) '("secondary")))))
(ert-deftest test-org-element/adopt-elements ()
"Test `org-element-adopt-elements' specifications."
;; Adopt an element.