Browse Source

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.
Nicolas Goaziou 2 years ago
parent
commit
1a88cf920e
6 changed files with 67 additions and 33 deletions
  1. 37 16
      lisp/org-element.el
  2. 3 4
      lisp/org-footnote.el
  3. 1 1
      lisp/org-src.el
  4. 3 4
      lisp/ox-odt.el
  5. 5 8
      lisp/ox.el
  6. 18 0
      testing/lisp/test-org-element.el

+ 37 - 16
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)

+ 3 - 4
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.

+ 1 - 1
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))))))
 

+ 3 - 4
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))))

+ 5 - 8
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))))

+ 18 - 0
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.