Browse Source

org-export: Define tools for tables, table rows and table cells

* contrib/lisp/org-export.el (org-export-table-cell-width,
  org-export-table-cell-alignment, org-export-table-cell-borders,
  org-export-table-row-group, org-export-table-has-special-column-p,
  org-export-table-row-is-special-p, org-export-get-parent-table,
  org-export-table-dimensions, org-export-table-cell-address,
  org-export-get-table-cell-at, org-export-table-has-header-p,
  org-export-table-cell-starts-colgroup-p,
  org-export-table-cell-ends-colgroup-p,
  org-export-table-row-starts-rowgroup-p,
  org-export-table-row-ends-rowgroup-p,
  org-export-table-row-starts-header-p,
  org-export-table-row-ends-header-p): New functions.
(org-export-table-format-info, org-export-clean-table): Removed
functions.
(org-export-filter-table-cell-functions,
org-export-filter-table-row-functions): New variables.
(org-export-filters-alist): Install new filters.
(org-export-collect-tree-properties, org-export--skip-p): Mark special
rows and cells as ignored.
* testing/lisp/test-org-export.el: Add tests.
Nicolas Goaziou 13 years ago
parent
commit
172ae310a8
2 changed files with 1049 additions and 140 deletions
  1. 485 140
      contrib/lisp/org-export.el
  2. 564 0
      testing/lisp/test-org-export.el

+ 485 - 140
contrib/lisp/org-export.el

@@ -219,6 +219,8 @@ way they are handled must be hard-coded into
     (:filter-subscript . org-export-filter-subscript-functions)
     (:filter-superscript . org-export-filter-superscript-functions)
     (:filter-table . org-export-filter-table-functions)
+    (:filter-table-cell . org-export-filter-table-cell-functions)
+    (:filter-table-row . org-export-filter-table-row-functions)
     (:filter-target . org-export-filter-target-functions)
     (:filter-time-stamp . org-export-filter-time-stamp-functions)
     (:filter-verbatim . org-export-filter-verbatim-functions)
@@ -1285,6 +1287,9 @@ Following tree properties are set or updated:
 `:parse-tree'      Whole parse tree.
 
 `:target-list'     List of all targets in the parse tree."
+  ;; Install the parse tree in the communication channel, in order to
+  ;; use `org-export-get-genealogy' and al.
+  (setq info (plist-put info :parse-tree data))
   ;; Get the list of elements and objects to ignore, and put it into
   ;; `:ignore-list'.  Do not overwrite any user ignore that might have
   ;; been done during parse tree filtering.
@@ -1314,9 +1319,7 @@ Following tree properties are set or updated:
   ;; Properties order doesn't matter: get the rest of the tree
   ;; properties.
   (nconc
-   `(:parse-tree
-     ,data
-     :target-list
+   `(:target-list
      ,(org-element-map
        data '(keyword target)
        (lambda (blob)
@@ -1393,10 +1396,7 @@ Return elements or objects to ignore as a list."
 		       (mapc (lambda (e) (push e ignore))
 			     (org-element-contents el))
 		     ;; Move into recursive objects/elements.
-		     (when (or (eq type 'org-data)
-			       (memq type org-element-greater-elements)
-			       (memq type org-element-recursive-objects)
-			       (eq type 'paragraph))
+		     (when (org-element-contents el)
 		       (funcall walk-data el options selected))))))
 	     (org-element-contents data))))))
     ;; Main call.  First find trees containing a select tag, if any.
@@ -1469,7 +1469,14 @@ OPTIONS is the plist holding export options."
      (or (not (plist-get options :with-drawers))
 	 (and (consp (plist-get options :with-drawers))
 	      (not (member (org-element-property :drawer-name blob)
-			   (plist-get options :with-drawers))))))))
+			   (plist-get options :with-drawers))))))
+    ;; Check table-row.
+    (table-row (org-export-table-row-is-special-p blob options))
+    ;; Check table-cell.
+    (table-cell
+     (and (org-export-table-has-special-column-p
+	   (nth 1 (org-export-get-genealogy blob options)))
+	  (not (org-export-get-previous-element blob options))))))
 
 
 
@@ -1487,7 +1494,7 @@ OPTIONS is the plist holding export options."
 
 ;; Internally, three functions handle the filtering of objects and
 ;; elements during the export.  In particular,
-;; `org-export-ignore-element' mark an element or object so future
+;; `org-export-ignore-element' marks an element or object so future
 ;; parse tree traversals skip it, `org-export-interpret-p' tells which
 ;; elements or objects should be seen as real Org syntax and
 ;; `org-export-expand' transforms the others back into their original
@@ -1540,14 +1547,11 @@ Return transcoded string."
 	      ;; 2. Compute CONTENTS of BLOB.
 	      (contents
 	       (cond
-		;; Case 0. No transcoder defined: ignore BLOB.
-		((not transcoder) nil)
+		;; Case 0. No transcoder or no contents: ignore BLOB.
+		((or (not transcoder) (not (org-element-contents blob))) nil)
 		;; Case 1. Transparently export an Org document.
 		((eq type 'org-data) (org-export-data blob backend info))
-		;; Case 2. For a recursive object.
-		((memq type org-element-recursive-objects)
-		 (org-export-data blob backend info))
-		;; Case 3. For a recursive element.
+		;; Case 2. For a greater element.
 		((memq type org-element-greater-elements)
 		 ;; Ignore contents of an archived tree
 		 ;; when `:with-archived-trees' is `headline'.
@@ -1557,20 +1561,21 @@ Return transcoded string."
 			  (org-element-property :archivedp blob))
 		   (org-element-normalize-string
 		    (org-export-data blob backend info))))
-		;; Case 4. For a paragraph.
-		((eq type 'paragraph)
-		 (let ((paragraph
-			(org-element-normalize-contents
-			 blob
-			 ;; When normalizing contents of an item or
-			 ;; a footnote definition, ignore first line's
-			 ;; indentation: there is none and it might be
-			 ;; misleading.
-			 (and (not (org-export-get-previous-element blob info))
-			      (let ((parent (org-export-get-parent blob info)))
-				(memq (org-element-type parent)
-				      '(footnote-definition item)))))))
-		   (org-export-data paragraph backend info)))))
+		;; Case 3. For an element containing objects.
+		(t
+		 (org-export-data
+		  (org-element-normalize-contents
+		   blob
+		   ;; When normalizing contents of the first paragraph
+		   ;; in an item or a footnote definition, ignore
+		   ;; first line's indentation: there is none and it
+		   ;; might be misleading.
+		   (and (eq type 'paragraph)
+			(not (org-export-get-previous-element blob info))
+			(let ((parent (org-export-get-parent blob info)))
+			  (memq (org-element-type parent)
+				'(footnote-definition item)))))
+		  backend info))))
 	      ;; 3. Transcode BLOB into RESULTS string.
 	      (results (cond
 			((not transcoder) nil)
@@ -1885,6 +1890,20 @@ Each filter is called with three arguments: the transcoded table,
 as a string, the back-end, as a symbol, and the communication
 channel, as a plist.  It must return a string or nil.")
 
+(defvar org-export-filter-table-cell-functions nil
+  "List of functions applied to a transcoded table-cell.
+Each filter is called with three arguments: the transcoded
+table-cell, as a string, the back-end, as a symbol, and the
+communication channel, as a plist.  It must return a string or
+nil.")
+
+(defvar org-export-filter-table-row-functions nil
+  "List of functions applied to a transcoded table-row.
+Each filter is called with three arguments: the transcoded
+table-row, as a string, the back-end, as a symbol, and the
+communication channel, as a plist.  It must return a string or
+nil.")
+
 (defvar org-export-filter-verse-block-functions nil
   "List of functions applied to a transcoded verse block.
 Each filter is called with three arguments: the transcoded verse
@@ -3140,106 +3159,429 @@ code."
 
 ;;;; For Tables
 
-;; `org-export-table-format-info' extracts formatting information
-;; (alignment, column groups and presence of a special column) from
-;; a raw table and returns it as a property list.
-;;
-;; `org-export-clean-table' cleans the raw table from any Org
-;; table-specific syntax.
-
-(defun org-export-table-format-info (table)
-  "Extract info from TABLE.
-Return a plist whose properties and values are:
-`:alignment'        vector of strings among \"r\", \"l\" and \"c\",
-`:column-groups'    vector of symbols among `start', `end', `start-end',
-`:row-groups'       list of integers representing row groups.
-`:special-column-p' non-nil if table has a special column.
-`:width'            vector of integers representing desired width of
-		    current column, or nil."
-  (with-temp-buffer
-    (insert table)
-    (goto-char 1)
-    (org-table-align)
-    (let ((align (vconcat (mapcar (lambda (c) (if c "r" "l"))
-				  org-table-last-alignment)))
-	  (width (make-vector (length org-table-last-alignment) nil))
-	  (colgroups (make-vector (length org-table-last-alignment) nil))
-	  (row-group 0)
-	  (rowgroups)
-	  (special-column-p 'empty))
-      (mapc (lambda (row)
-	      (if (string-match "^[ \t]*|[-+]+|[ \t]*$" row)
-		  (incf row-group)
-		;; Determine if a special column is present by looking
-		;; for special markers in the first column.  More
-		;; accurately, the first column is considered special
-		;; if it only contains special markers and, maybe,
-		;; empty cells.
-		(setq special-column-p
-		      (cond
-		       ((not special-column-p) nil)
-		       ((string-match "^[ \t]*| *\\\\?\\([/#!$*_^]\\) *|" row)
-			'special)
-		       ((string-match "^[ \t]*| +|" row) special-column-p))))
-	      (cond
-	       ;; Read forced alignment and width information, if any,
-	       ;; and determine final alignment for the table.
-	       ((org-table-cookie-line-p row)
-		(let ((col 0))
-		  (mapc (lambda (field)
-			  (when (string-match
-				 "<\\([lrc]\\)?\\([0-9]+\\)?>" field)
-			    (let ((align-data (match-string 1 field)))
-			      (when align-data (aset align col align-data)))
-			    (let ((w-data (match-string 2 field)))
-			      (when w-data
-				(aset width col (string-to-number w-data)))))
-			  (incf col))
-			(org-split-string row "[ \t]*|[ \t]*"))))
-	       ;; Read column groups information.
-	       ((org-table-colgroup-line-p row)
-		(let ((col 0))
-		  (mapc (lambda (field)
-			  (aset colgroups col
-				(cond ((string= "<" field) 'start)
-				      ((string= ">" field) 'end)
-				      ((string= "<>" field) 'start-end)))
-			  (incf col))
-			(org-split-string row "[ \t]*|[ \t]*"))))
-	       ;; Contents line.
-	       (t (push row-group rowgroups))))
-	    (org-split-string table "\n"))
-      ;; Return plist.
-      (list :alignment align
-	    :column-groups colgroups
-	    :row-groups (reverse rowgroups)
-	    :special-column-p (eq special-column-p 'special)
-	    :width width))))
-
-(defun org-export-clean-table (table specialp)
-  "Clean string TABLE from its formatting elements.
-Remove any row containing column groups or formatting cookies and
-rows starting with a special marker.  If SPECIALP is non-nil,
-assume the table contains a special formatting column and remove
-it also."
-  (let ((rows (org-split-string table "\n")))
-    (mapconcat 'identity
-	       (delq nil
-		     (mapcar
-		      (lambda (row)
-			(cond
-			 ((org-table-colgroup-line-p row) nil)
-			 ((org-table-cookie-line-p row) nil)
-			 ;; Ignore rows starting with a special marker.
-			 ((string-match "^[ \t]*| *[!_^/$] *|" row) nil)
-			 ;; Remove special column.
-			 ((and specialp
-			       (or (string-match "^\\([ \t]*\\)|-+\\+" row)
-				   (string-match "^\\([ \t]*\\)|[^|]*|" row)))
-			  (replace-match "\\1|" t nil row))
-			 (t row)))
-		      rows))
-	       "\n")))
+;; `org-export-table-has-special-column-p' and
+;; `org-export-table-row-is-special-p' are predicates used to look for
+;; meta-information about the table structure.
+
+;; `org-export-table-cell-width', `org-export-table-cell-alignment'
+;; and `org-export-table-cell-borders' extract information from
+;; a table-cell element.
+
+;; `org-export-table-dimensions' gives the number on rows and columns
+;; in the table, ignoring horizontal rules and special columns.
+;; `org-export-table-cell-address', given a table-cell object, returns
+;; the absolute address of a cell. On the other hand,
+;; `org-export-get-table-cell-at' does the contrary.
+
+(defun org-export-table-has-special-column-p (table)
+  "Non-nil when TABLE has a special column.
+All special columns will be ignored during export."
+  ;; The table has a special column when every first cell of every row
+  ;; has an empty value or contains a symbol among "/", "#", "!", "$",
+  ;; "*" "_" and "^".  Though, do not consider a first row containing
+  ;; only empty cells as special.
+  (let ((special-column-p 'empty))
+    (catch 'exit
+      (mapc
+       (lambda (row)
+	 (when (eq (org-element-property :type row) 'standard)
+	   (let ((value (org-element-contents
+			 (car (org-element-contents row)))))
+	     (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
+		    (setq special-column-p 'special))
+		   ((not value))
+		   (t (throw 'exit nil))))))
+       (org-element-contents table))
+      (eq special-column-p 'special))))
+
+(defun org-export-table-has-header-p (table info)
+  "Non-nil when TABLE has an header.
+
+INFO is a plist used as a communication channel.
+
+A table has an header when it contains at least two row groups."
+  (let ((rowgroup 1) row-flag)
+    (org-element-map
+     table 'table-row
+     (lambda (row)
+       (cond
+	((> rowgroup 1) t)
+	((and row-flag (eq (org-element-property :type row) 'rule))
+	 (incf rowgroup) (setq row-flag nil))
+	((and (not row-flag) (eq (org-element-property :type row) 'standard))
+	 (setq row-flag t) nil)))
+     info)))
+
+(defun org-export-table-row-is-special-p (table-row info)
+  "Non-nil if TABLE-ROW is considered special.
+
+INFO is a plist used as the communication channel.
+
+All special rows will be ignored during export."
+  (when (eq (org-element-property :type table-row) 'standard)
+    (let ((first-cell (org-element-contents
+		       (car (org-element-contents table-row)))))
+      ;; A row is special either when...
+      (or
+       ;; ... it starts with a field only containing "/",
+       (equal first-cell '("/"))
+       ;; ... the table contains a special column and the row start
+       ;; with a marking character among, "^", "_", "$" or "!",
+       (and (org-export-table-has-special-column-p
+	     (org-export-get-parent table-row info))
+	    (member first-cell '(("^") ("_") ("$") ("!"))))
+       ;; ... it contains only alignment cookies and empty cells.
+       (let ((special-row-p 'empty))
+	 (catch 'exit
+	   (mapc
+	    (lambda (cell)
+	      (let ((value (org-element-contents cell)))
+		(cond ((not value))
+		      ((and (not (cdr value))
+			    (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'"
+					  (car value)))
+		       (setq special-row-p 'cookie))
+		      (t (throw 'exit nil)))))
+	    (org-element-contents table-row))
+	   (eq special-row-p 'cookie)))))))
+
+(defun org-export-table-row-group (table-row info)
+  "Return TABLE-ROW's group.
+
+INFO is a plist used as the communication channel.
+
+Return value is the group number, as an integer, or nil special
+rows and table rules.  Group 1 is also table's header."
+  (unless (or (eq (org-element-property :type table-row) 'rule)
+	      (org-export-table-row-is-special-p table-row info))
+    (let ((group 0) row-flag)
+      (catch 'found
+	(mapc
+	 (lambda (row)
+	   (cond
+	    ((and (eq (org-element-property :type row) 'standard)
+		  (not (org-export-table-row-is-special-p row info)))
+	     (unless row-flag (incf group) (setq row-flag t)))
+	    ((eq (org-element-property :type row) 'rule)
+	     (setq row-flag nil)))
+	   (when (equal table-row row) (throw 'found group)))
+	 (org-element-contents (org-export-get-parent table-row info)))))))
+
+(defun org-export-table-cell-width (table-cell info)
+  "Return TABLE-CELL contents width.
+
+INFO is a plist used as the communication channel.
+
+Return value is the width given by the last width cookie in the
+same column as TABLE-CELL, or nil."
+  (let* ((genealogy (org-export-get-genealogy table-cell info))
+	 (row (car genealogy))
+	 (column (let ((cells (org-element-contents row)))
+		   (- (length cells) (length (member table-cell cells)))))
+	 (table (nth 1 genealogy))
+	 cookie-width)
+    (mapc
+     (lambda (row)
+       (cond
+	;; In a special row, try to find a width cookie at COLUMN.
+	((org-export-table-row-is-special-p row info)
+	 (let ((value (org-element-contents
+		       (elt (org-element-contents row) column))))
+	   (cond
+	    ((not value))
+	    ((and (not (cdr value))
+		  (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" (car value))
+		  (match-string 1 (car value)))
+	     (setq cookie-width
+		   (string-to-number (match-string 1 (car value))))))))
+	;; Ignore table rules.
+	((eq (org-element-property :type row) 'rule))))
+     (org-element-contents table))
+    ;; Return value.
+    cookie-width))
+
+(defun org-export-table-cell-alignment (table-cell info)
+  "Return TABLE-CELL contents alignment.
+
+INFO is a plist used as the communication channel.
+
+Return alignment as specified by the last alignment cookie in the
+same column as TABLE-CELL.  If no such cookie is found, a default
+alignment value will be deduced from fraction of numbers in the
+column (see `org-table-number-fraction' for more information).
+Possible values are `left', `right' and `center'."
+  (let* ((genealogy (org-export-get-genealogy table-cell info))
+	 (row (car genealogy))
+	 (column (let ((cells (org-element-contents row)))
+		   (- (length cells) (length (member table-cell cells)))))
+	 (table (nth 1 genealogy))
+	 (number-cells 0)
+	 (total-cells 0)
+	 cookie-align)
+    (mapc
+     (lambda (row)
+       (cond
+	;; In a special row, try to find an alignment cookie at
+	;; COLUMN.
+	((org-export-table-row-is-special-p row info)
+	 (let ((value (org-element-contents
+		       (elt (org-element-contents row) column))))
+	   (cond
+	    ((not value))
+	    ((and (not (cdr value))
+		  (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'"
+				(car value))
+		  (match-string 1 (car value)))
+	     (setq cookie-align (match-string 1 (car value)))))))
+	;; Ignore table rules.
+	((eq (org-element-property :type row) 'rule))
+	;; In a standard row, check if cell's contents are expressing
+	;; some kind of number.  Increase NUMBER-CELLS accordingly.
+	;; Though, don't bother if an alignment cookie has already
+	;; defined cell's alignment.
+	((not cookie-align)
+	 (let ((value (org-element-interpret-secondary
+		       (org-element-contents
+			(elt (org-element-contents row) column)))))
+	   (incf total-cells)
+	   (when (string-match org-table-number-regexp value)
+	     (incf number-cells))))))
+     (org-element-contents table))
+    ;; Return value.  Alignment specified by cookies has precedence
+    ;; over alignment deduced from cells contents.
+    (cond ((equal cookie-align "l") 'left)
+	  ((equal cookie-align "r") 'right)
+	  ((equal cookie-align "c") 'center)
+	  ((>= (/ (float number-cells) total-cells) org-table-number-fraction)
+	   'right)
+	  (t 'left))))
+
+(defun org-export-table-cell-borders (table-cell info)
+  "Return TABLE-CELL borders.
+
+INFO is a plist used as a communication channel.
+
+Return value is a list of symbols, or nil.  Possible values are:
+`top', `bottom', `above', `below', `left' and `right'.  Note:
+`top' (resp. `bottom') only happen for a cell in the first
+row (resp. last row) of the table, ignoring table rules, if any.
+
+Returned borders ignore special rows."
+  (let* ((genealogy (org-export-get-genealogy table-cell info))
+	 (row (car genealogy))
+	 (table (nth 1 genealogy))
+	 borders)
+    ;; Top/above border?  TABLE-CELL has a border above when a rule
+    ;; used to demarcate row groups can be found above.  Hence,
+    ;; finding a rule isn't sufficient to push `above' in BORDERS:
+    ;; another regular row has to be found above that rule.
+    (let (rule-flag)
+      (catch 'exit
+	(mapc (lambda (row)
+		(cond ((eq (org-element-property :type row) 'rule)
+		       (setq rule-flag t))
+		      ((not (org-export-table-row-is-special-p row info))
+		       (if rule-flag (throw 'exit (push 'above borders))
+			 (throw 'exit nil)))))
+	      ;; Look at every row before the current one.
+	      (cdr (member row (reverse (org-element-contents table)))))
+	;; No rule above, or rule found starts the table (ignoring any
+	;; special row): TABLE-CELL is at the top of the table.
+	(when rule-flag (push 'above borders))
+	(push 'top borders)))
+    ;; Bottom/below border? TABLE-CELL has a border below when next
+    ;; non-regular row below is a rule.
+    (let (rule-flag)
+      (catch 'exit
+	(mapc (lambda (row)
+		(cond ((eq (org-element-property :type row) 'rule)
+		       (setq rule-flag t))
+		      ((not (org-export-table-row-is-special-p row info))
+		       (if rule-flag (throw 'exit (push 'below borders))
+			 (throw 'exit nil)))))
+	      ;; Look at every row after the current one.
+	      (cdr (member row (org-element-contents table))))
+	;; No rule below, or rule found ends the table (modulo some
+	;; special row): TABLE-CELL is at the bottom of the table.
+	(when rule-flag (push 'below borders))
+	(push 'bottom borders)))
+    ;; Right/left borders?  They can only be specified by column
+    ;; groups.  Column groups are defined in a row starting with "/".
+    ;; Also a column groups row only contains "<", "<>", ">" or blank
+    ;; cells.
+    (catch 'exit
+      (let ((column (let ((cells (org-element-contents row)))
+		      (- (length cells) (length (member table-cell cells))))))
+	(mapc
+	 (lambda (row)
+	   (unless (eq (org-element-property :type row) 'rule)
+	     (when (equal (org-element-contents
+			   (car (org-element-contents row)))
+			  '("/"))
+	       (let ((column-groups
+		      (mapcar
+		       (lambda (cell)
+			 (let ((value (org-element-contents cell)))
+			   (when (member value '(("<") ("<>") (">") nil))
+			     (car value))))
+		       (org-element-contents row))))
+		 ;; There's a left border when previous cell, if
+		 ;; any, ends a group, or current one starts one.
+		 (when (or (and (not (zerop column))
+				(member (elt column-groups (1- column))
+					'(">" "<>")))
+			   (member (elt column-groups column) '("<" "<>")))
+		   (push 'left borders))
+		 ;; There's a right border when next cell, if any,
+		 ;; starts a group, or current one ends one.
+		 (when (or (and (/= (1+ column) (length column-groups))
+				(member (elt column-groups (1+ column))
+					'("<" "<>")))
+			   (member (elt column-groups column) '(">" "<>")))
+		   (push 'right borders))
+		 (throw 'exit nil)))))
+	 ;; Table rows are read in reverse order so last column groups
+	 ;; row has precedence over any previous one.
+	 (reverse (org-element-contents table)))))
+    ;; Return value.
+    borders))
+
+(defun org-export-table-cell-starts-colgroup-p (table-cell info)
+  "Non-nil when TABLE-CELL is at the beginning of a row group.
+INFO is a plist used as a communication channel."
+  ;; A cell starts a column group either when it is at the beginning
+  ;; of a row (or after the special column, if any) or when it has
+  ;; a left border.
+  (or (equal (org-element-map
+	      (org-export-get-parent table-cell info)
+	      'table-cell 'identity info 'first-match)
+	     table-cell)
+      (memq 'left (org-export-table-cell-borders table-cell info))))
+
+(defun org-export-table-cell-ends-colgroup-p (table-cell info)
+  "Non-nil when TABLE-CELL is at the end of a row group.
+INFO is a plist used as a communication channel."
+  ;; A cell ends a column group either when it is at the end of a row
+  ;; or when it has a right border.
+  (or (equal (car (last (org-element-contents
+			 (org-export-get-parent table-cell info))))
+	     table-cell)
+      (memq 'right (org-export-table-cell-borders table-cell info))))
+
+(defun org-export-table-row-starts-rowgroup-p (table-row info)
+  "Non-nil when TABLE-ROW is at the beginning of a column group.
+INFO is a plist used as a communication channel."
+  (unless (or (eq (org-element-property :type table-row) 'rule)
+	      (org-export-table-row-is-special-p table-row info))
+    (let ((borders (org-export-table-cell-borders
+		    (car (org-element-contents table-row)) info)))
+      (or (memq 'top borders) (memq 'above borders)))))
+
+(defun org-export-table-row-ends-rowgroup-p (table-row info)
+  "Non-nil when TABLE-ROW is at the end of a column group.
+INFO is a plist used as a communication channel."
+  (unless (or (eq (org-element-property :type table-row) 'rule)
+	      (org-export-table-row-is-special-p table-row info))
+    (let ((borders (org-export-table-cell-borders
+		    (car (org-element-contents table-row)) info)))
+      (or (memq 'bottom borders) (memq 'below borders)))))
+
+(defun org-export-table-row-starts-header-p (table-row info)
+  "Non-nil when TABLE-ROW is the first table header's row.
+INFO is a plist used as a communication channel."
+  (and (org-export-table-has-header-p
+	(org-export-get-parent-table table-row info) info)
+       (org-export-table-row-starts-rowgroup-p table-row info)
+       (= (org-export-table-row-group table-row info) 1)))
+
+(defun org-export-table-row-ends-header-p (table-row info)
+  "Non-nil when TABLE-ROW is the last table header's row.
+INFO is a plist used as a communication channel."
+  (and (org-export-table-has-header-p
+	(org-export-get-parent-table table-row info) info)
+       (org-export-table-row-ends-rowgroup-p table-row info)
+       (= (org-export-table-row-group table-row info) 1)))
+
+(defun org-export-table-dimensions (table info)
+  "Return TABLE dimensions.
+
+INFO is a plist used as a communication channel.
+
+Return value is a CONS like (ROWS . COLUMNS) where
+ROWS (resp. COLUMNS) is the number of exportable
+rows (resp. columns)."
+  (let (first-row (columns 0) (rows 0))
+    ;; Set number of rows, and extract first one.
+    (org-element-map
+     table 'table-row
+     (lambda (row)
+       (when (eq (org-element-property :type row) 'standard)
+	 (incf rows)
+	 (unless first-row (setq first-row row)))) info)
+    ;; Set number of columns.
+    (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info)
+    ;; Return value.
+    (cons rows columns)))
+
+(defun org-export-table-cell-address (table-cell info)
+  "Return address of a regular TABLE-CELL object.
+
+TABLE-CELL is the cell considered.  INFO is a plist used as
+a communication channel.
+
+Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are
+zero-based index.  Only exportable cells are considered.  The
+function returns nil for other cells."
+  (let* ((table-row (org-export-get-parent table-cell info))
+	 (table (org-export-get-parent-table table-cell info)))
+    ;; Ignore cells in special rows or in special column.
+    (unless (or (org-export-table-row-is-special-p table-row info)
+		(and (org-export-table-has-special-column-p table)
+		     (equal (car (org-element-contents table-row)) table-cell)))
+      (cons
+       ;; Row number.
+       (let ((row-count 0))
+	 (org-element-map
+	  table 'table-row
+	  (lambda (row)
+	    (cond ((eq (org-element-property :type row) 'rule) nil)
+		  ((equal row table-row) row-count)
+		  (t (incf row-count) nil)))
+	  info 'first-match))
+       ;; Column number.
+       (let ((col-count 0))
+	 (org-element-map
+	  table-row 'table-cell
+	  (lambda (cell)
+	    (if (equal cell table-cell) col-count
+	      (incf col-count) nil))
+	  info 'first-match))))))
+
+(defun org-export-get-table-cell-at (address table info)
+  "Return regular table-cell object at ADDRESS in TABLE.
+
+Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are
+zero-based index.  TABLE is a table type element.  INFO is
+a plist used as a communication channel.
+
+If no table-cell, among exportable cells, is found at ADDRESS,
+return nil."
+  (let ((column-pos (cdr address)) (column-count 0))
+    (org-element-map
+     ;; Row at (car address) or nil.
+     (let ((row-pos (car address)) (row-count 0))
+       (org-element-map
+	table 'table-row
+	(lambda (row)
+	  (cond ((eq (org-element-property :type row) 'rule) nil)
+		((= row-count row-pos) row)
+		(t (incf row-count) nil)))
+	info 'first-match))
+     'table-cell
+     (lambda (cell)
+       (if (= column-count column-pos) cell
+	 (incf column-count) nil))
+     info 'first-match)))
 
 
 ;;;; For Tables Of Contents
@@ -3380,8 +3722,7 @@ as a communication channel."
   (car (org-export-get-genealogy blob info)))
 
 (defun org-export-get-parent-headline (blob info)
-  "Return closest parent headline or nil.
-
+  "Return BLOB parent headline or nil.
 BLOB is the element or object being considered.  INFO is a plist
 used as a communication channel."
   (catch 'exit
@@ -3391,21 +3732,25 @@ used as a communication channel."
     nil))
 
 (defun org-export-get-parent-paragraph (object info)
-  "Return parent paragraph or nil.
-
-INFO is a plist used as a communication channel.
-
-Optional argument OBJECT, when provided, is the object to consider.
-Otherwise, return the paragraph containing current object.
-
-This is useful for objects, which share attributes with the
-paragraph containing them."
+  "Return OBJECT parent paragraph or nil.
+OBJECT is the object to consider.  INFO is a plist used as
+a communication channel."
   (catch 'exit
     (mapc
      (lambda (el) (when (eq (org-element-type el) 'paragraph) (throw 'exit el)))
      (org-export-get-genealogy object info))
     nil))
 
+(defun org-export-get-parent-table (object info)
+  "Return OBJECT parent table or nil.
+OBJECT is either a `table-cell' or `table-element' type object.
+INFO is a plist used as a communication channel."
+  (catch 'exit
+    (mapc
+     (lambda (el) (when (eq (org-element-type el) 'table) (throw 'exit el)))
+     (org-export-get-genealogy object info))
+    nil))
+
 (defun org-export-get-previous-element (blob info)
   "Return previous element or object.
 

+ 564 - 0
testing/lisp/test-org-export.el

@@ -38,6 +38,23 @@ as Org syntax."
 		    transcoders)))
      ,@body))
 
+(defmacro org-test-with-parsed-data (data &rest body)
+  "Execute body with parsed data available.
+
+DATA is a string containing the data to be parsed.  BODY is the
+body to execute.  Parse tree is available under the `tree'
+variable, and communication channel under `info'.
+
+This function calls `org-export-collect-tree-properties'.  As
+such, `:ignore-list' (for `org-element-map') and
+`:parse-tree' (for `org-export-get-genealogy') properties are
+already filled in `info'."
+  (declare (debug (form body)) (indent 1))
+  `(org-test-with-temp-text ,data
+     (let* ((tree (org-element-parse-buffer))
+	    (info (org-export-collect-tree-properties tree nil nil)))
+       ,@body)))
+
 (ert-deftest test-org-export/parse-option-keyword ()
   "Test reading all standard #+OPTIONS: items."
   (should
@@ -626,6 +643,553 @@ Another text. (ref:text)
 		     '("* Headline\n, * Not headline\n,Keep\n"))))))
 
 
+
+;;; Tables
+
+(ert-deftest test-org-export/special-column ()
+  "Test if the table's special column is properly recognized."
+  ;; 1. First column is special if it contains only a special marking
+  ;;    characters or empty cells.
+  (org-test-with-temp-text "
+| ! | 1 |
+|   | 2 |"
+    (should
+     (org-export-table-has-special-column-p
+      (org-element-map
+       (org-element-parse-buffer) 'table 'identity nil 'first-match))))
+  ;; 2. If the column contains anything else, it isn't special.
+  (org-test-with-temp-text "
+| ! | 1 |
+| b | 2 |"
+    (should-not
+     (org-export-table-has-special-column-p
+      (org-element-map
+       (org-element-parse-buffer) 'table 'identity nil 'first-match))))
+  ;; 3. Special marking characters are "#", "^", "*", "_", "/", "$"
+  ;;    and "!".
+  (org-test-with-temp-text "
+| # | 1 |
+| ^ | 2 |
+| * | 3 |
+| _ | 4 |
+| / | 5 |
+| $ | 6 |
+| ! | 7 |"
+    (should
+     (org-export-table-has-special-column-p
+      (org-element-map
+       (org-element-parse-buffer) 'table 'identity nil 'first-match))))
+  ;; 4. A first column with only empty cells isn't considered as
+  ;;    special.
+  (org-test-with-temp-text "
+|   | 1 |
+|   | 2 |"
+    (should-not
+     (org-export-table-has-special-column-p
+      (org-element-map
+       (org-element-parse-buffer) 'table 'identity nil 'first-match)))))
+
+(ert-deftest test-org-export/special-row ()
+  "Test if special rows in a table are properly recognized."
+  ;; 1. A row is special if it has a special marking character in the
+  ;;    special column.
+  (org-test-with-parsed-data "| ! | 1 |"
+    (should
+     (org-export-table-row-is-special-p
+      (org-element-map tree 'table-row 'identity nil 'first-match) info)))
+  ;; 2. A row is special when its first field is "/"
+  (org-test-with-parsed-data "
+| / | 1 |
+| a | b |"
+    (should
+     (org-export-table-row-is-special-p
+      (org-element-map tree 'table-row 'identity nil 'first-match) info)))
+  ;; 3. A row only containing alignment cookies is also considered as
+  ;;    special.
+  (org-test-with-parsed-data "| <5> |   | <l> | <l22> |"
+    (should
+     (org-export-table-row-is-special-p
+      (org-element-map tree 'table-row 'identity nil 'first-match) info)))
+  ;; 4. Everything else isn't considered as special.
+  (org-test-with-parsed-data "| a |   | c |"
+    (should-not
+     (org-export-table-row-is-special-p
+      (org-element-map tree 'table-row 'identity nil 'first-match) info)))
+  ;; 5. Table's rules are never considered as special rows.
+  (org-test-with-parsed-data "|---+---|"
+    (should-not
+     (org-export-table-row-is-special-p
+      (org-element-map tree 'table-row 'identity nil 'first-match) info))))
+
+(ert-deftest test-org-export/has-header-p ()
+  "Test `org-export-table-has-header-p' specifications."
+  ;; 1. With an header.
+  (org-test-with-parsed-data "
+| a | b |
+|---+---|
+| c | d |"
+    (should
+     (org-export-table-has-header-p
+      (org-element-map tree 'table 'identity info 'first-match)
+      info)))
+  ;; 2. Without an header.
+  (org-test-with-parsed-data "
+| a | b |
+| c | d |"
+    (should-not
+     (org-export-table-has-header-p
+      (org-element-map tree 'table 'identity info 'first-match)
+      info)))
+  ;; 3. Don't get fooled with starting and ending rules.
+  (org-test-with-parsed-data "
+|---+---|
+| a | b |
+| c | d |
+|---+---|"
+    (should-not
+     (org-export-table-has-header-p
+      (org-element-map tree 'table 'identity info 'first-match)
+      info))))
+
+(ert-deftest test-org-export/table-row-group ()
+  "Test `org-export-table-row-group' specifications."
+  ;; 1. A rule creates a new group.
+  (org-test-with-parsed-data "
+| a | b |
+|---+---|
+| 1 | 2 |"
+    (should
+     (equal
+      '(1 nil 2)
+      (mapcar (lambda (row) (org-export-table-row-group row info))
+	      (org-element-map tree 'table-row 'identity)))))
+  ;; 2. Special rows are ignored in count.
+  (org-test-with-parsed-data "
+| / | < | > |
+|---|---+---|
+|   | 1 | 2 |"
+    (should
+     (equal
+      '(nil nil 1)
+      (mapcar (lambda (row) (org-export-table-row-group row info))
+	      (org-element-map tree 'table-row 'identity)))))
+  ;; 3. Double rules also are ignored in count.
+  (org-test-with-parsed-data "
+| a | b |
+|---+---|
+|---+---|
+| 1 | 2 |"
+    (should
+     (equal
+      '(1 nil nil 2)
+      (mapcar (lambda (row) (org-export-table-row-group row info))
+	      (org-element-map tree 'table-row 'identity))))))
+
+(ert-deftest test-org-export/table-cell-width ()
+  "Test `org-export-table-cell-width' specifications."
+  ;; 1. Width is primarily determined by width cookies.  If no cookie
+  ;;    is found, cell's width is nil.
+  (org-test-with-parsed-data "
+| / | <l> | <6> | <l7> |
+|   |  a  |  b  |  c   |"
+    (should
+     (equal
+      '(nil 6 7)
+      (mapcar (lambda (cell) (org-export-table-cell-width cell info))
+	      (org-element-map tree 'table-cell 'identity info)))))
+  ;; 2. The last width cookie has precedence.
+  (org-test-with-parsed-data "
+| <6> |
+| <7> |
+|  a  |"
+    (should
+     (equal
+      '(7)
+      (mapcar (lambda (cell) (org-export-table-cell-width cell info))
+	      (org-element-map tree 'table-cell 'identity info)))))
+  ;; 3. Valid width cookies must have a specific row.
+  (org-test-with-parsed-data "| <6> | cell |"
+    (should
+     (equal
+      '(nil nil)
+      (mapcar (lambda (cell) (org-export-table-cell-width cell info))
+	      (org-element-map tree 'table-cell 'identity))))))
+
+(ert-deftest test-org-export/table-cell-alignment ()
+  "Test `org-export-table-cell-alignment' specifications."
+  (let ((org-table-number-fraction 0.5)
+	(org-table-number-regexp "^[0-9]+$"))
+    ;; 1. Alignment is primarily determined by alignment cookies.
+    (org-test-with-temp-text "| <l> | <c> | <r> |"
+      (let* ((tree (org-element-parse-buffer))
+	     (info `(:parse-tree ,tree)))
+	(should
+	 (equal
+	  '(left center right)
+	  (mapcar (lambda (cell) (org-export-table-cell-alignment cell info))
+		  (org-element-map tree 'table-cell 'identity))))))
+    ;; 2. The last alignment cookie has precedence.
+    (org-test-with-temp-text "
+| <l8> |
+| cell |
+| <r9> |"
+      (let* ((tree (org-element-parse-buffer))
+	     (info `(:parse-tree ,tree)))
+	(should
+	 (equal
+	  '(right right right)
+	  (mapcar (lambda (cell) (org-export-table-cell-alignment cell info))
+		  (org-element-map tree 'table-cell 'identity))))))
+    ;; 3. If there's no cookie, cell's contents determine alignment.
+    ;;    A column mostly made of cells containing numbers will align
+    ;;    its cells to the right.
+    (org-test-with-temp-text "
+| 123       |
+| some text |
+| 12345     |"
+      (let* ((tree (org-element-parse-buffer))
+	     (info `(:parse-tree ,tree)))
+	(should
+	 (equal
+	  '(right right right)
+	  (mapcar (lambda (cell)
+		    (org-export-table-cell-alignment cell info))
+		  (org-element-map tree 'table-cell 'identity))))))
+    ;; 5. Otherwise, they will be aligned to the left.
+    (org-test-with-temp-text "
+| text      |
+| some text |
+| 12345     |"
+      (let* ((tree (org-element-parse-buffer))
+	     (info `(:parse-tree ,tree)))
+	(should
+	 (equal
+	  '(left left left)
+	  (mapcar (lambda (cell)
+		    (org-export-table-cell-alignment cell info))
+		  (org-element-map tree 'table-cell 'identity))))))))
+
+(ert-deftest test-org-export/table-cell-borders ()
+  "Test `org-export-table-cell-borders' specifications."
+  ;; 1. Recognize various column groups indicators.
+  (org-test-with-parsed-data "| / | < | > | <> |"
+    (should
+     (equal
+      '((right bottom top) (left bottom top) (right bottom top)
+	(right left bottom top))
+      (mapcar (lambda (cell)
+		(org-export-table-cell-borders cell info))
+	      (org-element-map tree 'table-cell 'identity)))))
+  ;; 2. Accept shortcuts to define column groups.
+  (org-test-with-parsed-data "| / | < | < |"
+    (should
+     (equal
+      '((right bottom top) (right left bottom top) (left bottom top))
+      (mapcar (lambda (cell)
+		(org-export-table-cell-borders cell info))
+	      (org-element-map tree 'table-cell 'identity)))))
+  ;; 3. A valid column groups row must start with a "/".
+  (org-test-with-parsed-data "
+|   | < |
+| a | b |"
+    (should
+     (equal '((top) (top) (bottom) (bottom))
+	    (mapcar (lambda (cell)
+		      (org-export-table-cell-borders cell info))
+		    (org-element-map tree 'table-cell 'identity)))))
+  ;; 4. Take table rules into consideration.
+  (org-test-with-parsed-data "
+| 1 |
+|---|
+| 2 |"
+    (should
+     (equal '((below top) (bottom above))
+	    (mapcar (lambda (cell)
+		      (org-export-table-cell-borders cell info))
+		    (org-element-map tree 'table-cell 'identity)))))
+  ;; 5. Top and (resp. bottom) rules induce both `top' and `above'
+  ;;    (resp. `bottom' and `below') borders.  Any special row is
+  ;;    ignored.
+  (org-test-with-parsed-data "
+|---+----|
+| / |    |
+|   |  1 |
+|---+----|"
+    (should
+     (equal '((bottom below top above))
+	    (last
+	     (mapcar (lambda (cell)
+		       (org-export-table-cell-borders cell info))
+		     (org-element-map tree 'table-cell 'identity)))))))
+
+(ert-deftest test-org-export/table-dimensions ()
+  "Test `org-export-table-dimensions' specifications."
+  ;; 1. Standard test.
+  (org-test-with-parsed-data "
+| 1 | 2 | 3 |
+| 4 | 5 | 6 |"
+    (should
+     (equal '(2 . 3)
+	    (org-export-table-dimensions
+	     (org-element-map tree 'table 'identity info 'first-match) info))))
+  ;; 2. Ignore horizontal rules and special columns.
+  (org-test-with-parsed-data "
+| / | < | > |
+| 1 | 2 | 3 |
+|---+---+---|
+| 4 | 5 | 6 |"
+    (should
+     (equal '(2 . 3)
+	    (org-export-table-dimensions
+	     (org-element-map tree 'table 'identity info 'first-match) info)))))
+
+(ert-deftest test-org-export/table-cell-address ()
+  "Test `org-export-table-cell-address' specifications."
+  ;; 1. Standard test: index is 0-based.
+  (org-test-with-parsed-data "| a | b |"
+    (should
+     (equal '((0 . 0) (0 . 1))
+	    (org-element-map
+	     tree 'table-cell
+	     (lambda (cell) (org-export-table-cell-address cell info))
+	     info))))
+  ;; 2. Special column isn't counted, nor are special rows.
+  (org-test-with-parsed-data "
+| / | <> |
+|   | c  |"
+    (should
+     (equal '(0 . 0)
+	    (org-export-table-cell-address
+	     (car (last (org-element-map tree 'table-cell 'identity info)))
+	     info))))
+  ;; 3. Tables rules do not count either.
+  (org-test-with-parsed-data "
+| a |
+|---|
+| b |
+|---|
+| c |"
+    (should
+     (equal '(2 . 0)
+	    (org-export-table-cell-address
+	     (car (last (org-element-map tree 'table-cell 'identity info)))
+	     info))))
+  ;; 4. Return nil for special cells.
+  (org-test-with-parsed-data "| / | a |"
+    (should-not
+     (org-export-table-cell-address
+      (org-element-map tree 'table-cell 'identity nil 'first-match)
+      info))))
+
+(ert-deftest test-org-export/get-table-cell-at ()
+  "Test `org-export-get-table-cell-at' specifications."
+  ;; 1. Address ignores special columns, special rows and rules.
+  (org-test-with-parsed-data "
+| / | <> |
+|   | a  |
+|---+----|
+|   | b  |"
+    (should
+     (equal '("b")
+	    (org-element-contents
+	     (org-export-get-table-cell-at
+	      '(1 . 0)
+	      (org-element-map tree 'table 'identity info 'first-match)
+	      info)))))
+  ;; 2. Return value for a non-existent address is nil.
+  (org-test-with-parsed-data "| a |"
+    (should-not
+     (org-export-get-table-cell-at
+      '(2 . 2)
+      (org-element-map tree 'table 'identity info 'first-match)
+      info)))
+  (org-test-with-parsed-data "| / |"
+    (should-not
+     (org-export-get-table-cell-at
+      '(0 . 0)
+      (org-element-map tree 'table 'identity info 'first-match)
+      info))))
+
+(ert-deftest test-org-export/table-cell-starts-colgroup-p ()
+  "Test `org-export-table-cell-starts-colgroup-p' specifications."
+  ;; 1. A cell at a beginning of a row always starts a column group.
+  (org-test-with-parsed-data "| a |"
+    (should
+     (org-export-table-cell-starts-colgroup-p
+      (org-element-map tree 'table-cell 'identity info 'first-match)
+      info)))
+  ;; 2. Special column should be ignored when determining the
+  ;;    beginning of the row.
+  (org-test-with-parsed-data "
+| / |   |
+|   | a |"
+    (should
+     (org-export-table-cell-starts-colgroup-p
+      (org-element-map tree 'table-cell 'identity info 'first-match)
+      info)))
+  ;; 2. Explicit column groups.
+  (org-test-with-parsed-data "
+| / |   | < |
+| a | b | c |"
+    (should
+     (equal
+      '(yes no yes)
+      (org-element-map
+       tree 'table-cell
+       (lambda (cell)
+	 (if (org-export-table-cell-starts-colgroup-p cell info) 'yes 'no))
+       info)))))
+
+(ert-deftest test-org-export/table-cell-ends-colgroup-p ()
+  "Test `org-export-table-cell-ends-colgroup-p' specifications."
+  ;; 1. A cell at the end of a row always ends a column group.
+  (org-test-with-parsed-data "| a |"
+    (should
+     (org-export-table-cell-ends-colgroup-p
+      (org-element-map tree 'table-cell 'identity info 'first-match)
+      info)))
+  ;; 2. Special column should be ignored when determining the
+  ;;    beginning of the row.
+  (org-test-with-parsed-data "
+| / |   |
+|   | a |"
+    (should
+     (org-export-table-cell-ends-colgroup-p
+      (org-element-map tree 'table-cell 'identity info 'first-match)
+      info)))
+  ;; 3. Explicit column groups.
+  (org-test-with-parsed-data "
+| / | < |   |
+| a | b | c |"
+    (should
+     (equal
+      '(yes no yes)
+      (org-element-map
+       tree 'table-cell
+       (lambda (cell)
+	 (if (org-export-table-cell-ends-colgroup-p cell info) 'yes 'no))
+       info)))))
+
+(ert-deftest test-org-export/table-row-starts-rowgroup-p ()
+  "Test `org-export-table-row-starts-rowgroup-p' specifications."
+  ;; 1. A row at the beginning of a table always starts a row group.
+  ;;    So does a row following a table rule.
+  (org-test-with-parsed-data "
+| a |
+|---|
+| b |"
+    (should
+     (equal
+      '(yes no yes)
+      (org-element-map
+       tree 'table-row
+       (lambda (row)
+	 (if (org-export-table-row-starts-rowgroup-p row info) 'yes 'no))
+       info))))
+  ;; 2. Special rows should be ignored when determining the beginning
+  ;;    of the row.
+  (org-test-with-parsed-data "
+| / | < |
+|   | a |
+|---+---|
+| / | < |
+|   | b |"
+    (should
+     (equal
+      '(yes no yes)
+      (org-element-map
+       tree 'table-row
+       (lambda (row)
+	 (if (org-export-table-row-starts-rowgroup-p row info) 'yes 'no))
+       info)))))
+
+(ert-deftest test-org-export/table-row-ends-rowgroup-p ()
+  "Test `org-export-table-row-ends-rowgroup-p' specifications."
+  ;; 1. A row at the end of a table always ends a row group.  So does
+  ;;    a row preceding a table rule.
+  (org-test-with-parsed-data "
+| a |
+|---|
+| b |"
+    (should
+     (equal
+      '(yes no yes)
+      (org-element-map
+       tree 'table-row
+       (lambda (row)
+	 (if (org-export-table-row-ends-rowgroup-p row info) 'yes 'no))
+       info))))
+  ;; 2. Special rows should be ignored when determining the beginning
+  ;;    of the row.
+  (org-test-with-parsed-data "
+|   | a |
+| / | < |
+|---+---|
+|   | b |
+| / | < |"
+    (should
+     (equal
+      '(yes no yes)
+      (org-element-map
+       tree 'table-row
+       (lambda (row)
+	 (if (org-export-table-row-ends-rowgroup-p row info) 'yes 'no))
+       info)))))
+
+(ert-deftest test-org-export/table-row-starts-header-p ()
+  "Test `org-export-table-row-starts-header-p' specifications."
+  ;; 1. Only the row starting the first row group starts the table
+  ;;    header.
+  (org-test-with-parsed-data "
+| a |
+| b |
+|---|
+| c |"
+    (should
+     (equal
+      '(yes no no no)
+      (org-element-map
+       tree 'table-row
+       (lambda (row)
+	 (if (org-export-table-row-starts-header-p row info) 'yes 'no))
+       info))))
+  ;; 2. A row cannot start an header if there's no header in the
+  ;;    table.
+  (org-test-with-parsed-data "
+| a |
+|---|"
+    (should-not
+     (org-export-table-row-starts-header-p
+      (org-element-map tree 'table-row 'identity info 'first-match)
+      info))))
+
+(ert-deftest test-org-export/table-row-ends-header-p ()
+  "Test `org-export-table-row-ends-header-p' specifications."
+  ;; 1. Only the row starting the first row group starts the table
+  ;;    header.
+  (org-test-with-parsed-data "
+| a |
+| b |
+|---|
+| c |"
+    (should
+     (equal
+      '(no yes no no)
+      (org-element-map
+       tree 'table-row
+       (lambda (row)
+	 (if (org-export-table-row-ends-header-p row info) 'yes 'no))
+       info))))
+  ;; 2. A row cannot start an header if there's no header in the
+  ;;    table.
+  (org-test-with-parsed-data "
+| a |
+|---|"
+    (should-not
+     (org-export-table-row-ends-header-p
+      (org-element-map tree 'table-row 'identity info 'first-match)
+      info))))
+
 
 (provide 'test-org-export)
 ;;; test-org-export.el end here