diff --git a/lisp/org-element.el b/lisp/org-element.el index cbd842f71..50a5628c6 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 5ba4f5e05..c86ab84c9 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 f59d7eca5..c15a5f14c 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 4fb8c15c2..05d86bfb0 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%s" @@ -3334,8 +3334,7 @@ channel." (format "\n\n%s\n" 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%s" paragraph-style contents)))) diff --git a/lisp/ox.el b/lisp/ox.el index e234796d6..a99cbf949 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 35cd28b63..4b79be522 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.