summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-10-25 13:13:26 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-10-25 13:13:26 +0200
commit1a88cf920e5090c311f77ba3f74183aa51253fb5 (patch)
tree24b13d933b5a26b0bc46c3f825543aa732b3c1ed
parentdd670073de1a54f1146619cdbac2b0141f6d19af (diff)
downloadorg-mode-1a88cf920e5090c311f77ba3f74183aa51253fb5.tar.gz
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.
-rw-r--r--lisp/org-element.el53
-rw-r--r--lisp/org-footnote.el7
-rw-r--r--lisp/org-src.el2
-rw-r--r--lisp/ox-odt.el7
-rw-r--r--lisp/ox.el13
-rw-r--r--testing/lisp/test-org-element.el18
6 files changed, 67 insertions, 33 deletions
diff --git a/lisp/org-element.el b/lisp/org-element.el
index cbd842f..50a5628 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -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)
diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el
index 5ba4f5e..c86ab84 100644
--- a/lisp/org-footnote.el
+++ b/lisp/org-footnote.el
@@ -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.
diff --git a/lisp/org-src.el b/lisp/org-src.el
index f59d7ec..c15a5f1 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -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))))))
diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el
index 4fb8c15..05d86bf 100644
--- a/lisp/ox-odt.el
+++ b/lisp/ox-odt.el
@@ -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))))
diff --git a/lisp/ox.el b/lisp/ox.el
index e234796..a99cbf9 100644
--- a/lisp/ox.el
+++ b/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))))
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 35cd28b..4b79be5 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -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.