Allow for column alignment for org table export (#2391)

Co-authored-by: Yihui Xie <xie@yihui.name>

Author: mclements

NEWS.md

@@ -6,6 +6,8 @@
 
 - Display error traceback when vignettes fail in `R CMD build` (thanks, @hadley, #2390).
 
+- `kable()` properly supports column alignment for Org Mode tables now (thanks, @mclements, #2391).
+
 ## MINOR CHANGES
 
 - Moved implementations of `combine_words()` and `write_bib()` to the **xfun** package as `xfun::join_words()` and `xfun::pkg_bib()`, respectively, since they are not directly relevant to **knitr**. The functions `combine_words()` and `write_bib()` are still kept in **knitr**, and can continue to be used in the future.

R/table.R

@@ -403,7 +403,9 @@ kable_mark = function(x, sep.row = c('=', '=', '='), sep.col = '  ', padding = 0
   if (sep.col == '|') for (j in seq_len(ncol(x))) {
     x[, j] = gsub('\\|', '|', x[, j])
   }
-  l = if (prod(dim(x)) > 0) apply(x, 2, function(z) max(nchar(remove_urls(z), type = 'width'), na.rm = TRUE))
+  l = if (prod(dim(x)) > 0) apply(x, 2, function(z) {
+    max(nchar(remove_urls(z), type = 'width'), na.rm = TRUE)
+  }) else integer(ncol(x))
   cn = colnames(x)
   if (length(cn) > 0) {
     cn[is.na(cn)] = "NA"
@@ -417,8 +419,10 @@ kable_mark = function(x, sep.row = c('=', '=', '='), sep.col = '  ', padding = 0
   }
   l = pmax(l + padding, 3)  # at least of width 3 for Github Markdown
   s = strrep(sep.row[2], l)
-  res = rbind(if (!is.na(sep.row[1])) s, cn, align.fun(s, align),
-              x, if (!is.na(sep.row[3])) s)
+  res = rbind(
+    if (!is.na(sep.row[1])) s, cn, if (is.null(align)) s else align.fun(s, align),
+    x, if (!is.na(sep.row[3])) s
+  )
   res = mat_pad(res, l, align)
   res = add_mark_col_sep(res, sep.col, sep.head)
   if (is.character(newline)) res = gsub('\n', newline, res, fixed = TRUE)
@@ -442,7 +446,6 @@ kable_rst = function(x, rownames.name = '\\', ...) {
 kable_pipe = function(x, caption = NULL, padding = 1, caption.label = 'Table:', ...) {
   if (is.null(colnames(x))) colnames(x) = rep('', ncol(x))
   res = kable_mark(x, c(NA, '-', NA), '|', padding, align.fun = function(s, a) {
-    if (is.null(a)) return(s)
     r = c(l = '^.', c = '^.|.$', r = '.$')
     for (i in seq_along(s)) {
       s[i] = gsub(r[a[i]], ':', s[i])
@@ -477,14 +480,16 @@ kable_jira = function(x, caption = NULL, padding = 1, ...) {
 }
 
 # Emacs Org-mode table
-kable_org = function(...) {
-  res = kable_pipe(..., caption.label = '#+CAPTION:')
-  i = grep('^[-:|]+$', res)  # find the line like |--:|---| under header
-  if (length(i)) {
-    i = i[1]
-    res[i] = gsub('(-|:)[|](-|:)', '\\1+\\2', res[i])  # use + as separator
-  }
-  res
+kable_org = function(x, caption = NULL, padding = 1, caption.label = '#+CAPTION:', ...) {
+  has_header = !is.null(colnames(x))
+  res = kable_mark(x, c(NA, '-', NA), '|', padding, align.fun = function(s, a) {
+    r = c(l = '<l>', c = '<c>', r = '<r>')
+    rbind(r[a], if (has_header) s)
+  }, ...)
+  if (!is.na(i <- grep('^(---+[|])+---+$', res)[1]))
+    res[i] = gsub('|', '+', res[i], fixed = TRUE)
+  res = sprintf('|%s|', res)
+  kable_pandoc_caption(res, caption, caption.label)
 }
 
 kable_pandoc_caption = function(x, caption, label = 'Table:') {

tests/testit/test-table.R

@@ -40,7 +40,13 @@ assert('kable() works with the jira format', {
 })
 
 assert('kable() works with the org format', {
-  (kable2(m, 'org') %==% c('|   |  x|  y|', '|:--+--:+--:|', '|a  |  1|  2|'))
+  (kable2(m, 'org') %==%
+    c('|   |  x|  y|', '|<l>|<r>|<r>|', '|---+---+---|', '|a  |  1|  2|'))
+  m2 = m; colnames(m2) = NULL  # no column names
+  (kable2(m2, 'org') %==% c('|<l>|<r>|<r>|', '|a  |  1|  2|'))
+  # the case of only one column
+  (kable2(m[, 1, drop = FALSE], 'org', row.names = FALSE) %==%
+    c('|  x|', '|<r>|', '|---|', '|  1|'))
 })
 
 assert('kable() does not add extra spaces to character columns', {