summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2012-04-11 08:54:24 +0200
committerJambunathan K <kjambunathan@gmail.com>2012-04-22 19:41:45 +0530
commit172ae310a80a11b47f26a3b70b39baeb01a8f34a (patch)
treed6fcdc26eb7bd2ff971579a17ada62b4405a18b8
parenteeeee5f1da278370e3843b3cd1e4b8994d3dbe33 (diff)
downloadorg-mode-172ae310a80a11b47f26a3b70b39baeb01a8f34a.tar.gz
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.
-rw-r--r--contrib/lisp/org-export.el625
-rw-r--r--testing/lisp/test-org-export.el564
2 files changed, 1049 insertions, 140 deletions
diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
index 939a697..5c8d672 100644
--- a/contrib/lisp/org-export.el
+++ b/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.
diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el
index 4f06c36..d5eefbd 100644
--- a/testing/lisp/test-org-export.el
+++ b/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