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:
parent
dd670073de
commit
1a88cf920e
|
@ -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)
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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))))))
|
||||
|
||||
|
|
|
@ -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))))
|
||||
|
|
13
lisp/ox.el
13
lisp/ox.el
|
@ -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))))
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in New Issue