Merge changes from master, fix conflicting #813.

Still has consistency issues.

Merge branch 'master' into protect_xml

# Conflicts:
#	R/util.R

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: kableExtra
 Type: Package
 Title: Construct Complex Table with 'kable' and Pipe Syntax
-Version: 1.3.9.9000
+Version: 1.4.0.1
 Authors@R: c(
     person('Hao', 'Zhu', email = 'haozhu233@gmail.com', role = c('aut', 'cre'),
     comment = c(ORCID = '0000-0002-3386-6076')),
@@ -17,6 +17,7 @@ Authors@R: c(
     person('George', 'Gui', role = 'ctb'),
     person('Yeliang', 'Fan', role = 'ctb'),
     person('Duncan', 'Murdoch', role = 'ctb'),
+    person('Vincent', 'Arel-Bundock', role = 'ctb'),
     person('Bill', 'Evans',  role = 'ctb')
     )
 Description: Build complex HTML or 'LaTeX' tables using 'kable()' from 'knitr' 
@@ -49,9 +50,11 @@ Imports:
 Suggests:
     testthat,
     magick,
+    tinytex,
     formattable,
     sparkline,
     webshot2
+Config/testthat/edition: 3
 VignetteBuilder: knitr
 Encoding: UTF-8
 RoxygenNote: 7.2.3

R/add_footnote.R

@@ -23,14 +23,11 @@
 #'
 #' @export
 add_footnote <- function(input, label = NULL,
-                         notation = "alphabet",
+                         notation = getOption("kable_footnote_notation", "alphabet"),
                          threeparttable = FALSE,
                          escape = TRUE) {
   if (is.null(label)) return(input)
 
-  if (notation == "alphabet") {
-    notation <- getOption("kable_footnote_notation", "alphabet")
-  }
   if (!threeparttable) {
     threeparttable <- getOption("kable_footnote_threeparttable", FALSE)
   }
@@ -76,10 +73,14 @@ add_footnote <- function(input, label = NULL,
   # should be able to satisfy people who don't want to spend extra
   # time to define their `kable` format.
   if (!attr(input, "format") %in% c("html", "latex")) {
+    if (notation == "none")
+      ids.innote <- ids.intable  # issue #672
+    else
+      ids.innote <- paste0("^", ids.intable, "^")
     # In table notation
     if (count.intablenote != 0) {
       for (i in 1:count.intablenote) {
-        replace_note <- paste0("^", ids.intable[i], "^",
+        replace_note <- paste0(ids.innote[i],
                                paste0(rep(" ", 4 - ceiling(i/5)), collapse = ""))
 
         export[which(str_detect(export, "\\[note\\]"))[1]] <-
@@ -90,15 +91,15 @@ add_footnote <- function(input, label = NULL,
     # Fix extra in table notation
     for (i in extra.notation) {
       export <- gsub(paste0("\\[note", i, "\\]"),
-                     paste0("^", ids.intable[i], "^",
+                     paste0(ids.innote[i],
                             paste0(rep(" ", 4 - ceiling(i/5)), collapse = "")),
                      export)
     }
 
     export[length(export) + 1] <- ""
     export[length(export) + 1] <- "__Note:__"
     export[length(export) + 1] <- paste0(
-      paste0("^", ids[1:length(label)], "^ ", label), collapse = " "
+      paste0(ids.innote[1:length(label)], label), collapse = " "
     )
   }
 
@@ -143,9 +144,9 @@ add_footnote <- function(input, label = NULL,
             label[i], "}")
         }
 
-        if (str_detect(export, "\\\\toprule")) {
-          export <- sub("\\\\toprule",
-                        paste0("\\\\toprule\n", caption.footnote), export)
+        if (str_detect(export, toprule_regexp)) {
+          export <- sub(toprule_regexp,
+                        paste0("\\1\n", caption.footnote), export)
         } else {
           export <- sub("\\\\hline",
                         paste0("\\\\hline\n", caption.footnote), export)

R/add_header_above.R

@@ -125,7 +125,9 @@ htmlTable_add_header_above <- function(kable_input, header, bold, italic,
                                        angle, escape, line, line_sep,
                                        extra_css, include_empty) {
   kable_attrs <- attributes(kable_input)
-  kable_xml <- read_kable_as_xml(kable_input)
+  important_nodes <- read_kable_as_xml(kable_input)
+  body_node <- important_nodes$body
+  kable_xml <- important_nodes$table
   kable_xml_thead <- xml_tpart(kable_xml, "thead")
 
   if (escape) {
@@ -163,7 +165,7 @@ htmlTable_add_header_above <- function(kable_input, header, bold, italic,
     include_empty, attr(kable_input, 'lightable_class')
   )
   xml_add_child(kable_xml_thead, new_header_row, .where = 0)
-  out <- as_kable_xml(kable_xml)
+  out <- as_kable_xml(body_node)
   if (is.null(kable_attrs$header_above)) {
     kable_attrs$header_above <- 1
   } else {
@@ -316,7 +318,7 @@ pdfTable_add_header_above <- function(kable_input, header, bold, italic,
 
   align <- vapply(align, match.arg, 'a', choices = c("l", "c", "r"))
 
-  hline_type <- switch(table_info$booktabs + 1, "\\\\hline", "\\\\toprule")
+  hline_type <- switch(table_info$booktabs + 1, "(\\\\hline)", toprule_regexp)
   new_header_split <- pdfTable_new_header_generator(
     header, table_info$booktabs, bold, italic, monospace, underline, strikeout,
     align, color, background, font_size, angle, line_sep,
@@ -328,7 +330,7 @@ pdfTable_add_header_above <- function(kable_input, header, bold, italic,
   }
   out <- str_replace(solve_enc(kable_input),
                      hline_type,
-                     paste0(hline_type, "\n", new_header))
+                     paste0("\\1\n", new_header))
   out <- structure(out, format = "latex", class = "knitr_kable")
   # new_header_row <- latex_contents_escape(new_header_split[1])
   if (is.null(table_info$new_header_row)) {

R/add_indent.R

@@ -35,10 +35,14 @@ add_indent <- function(kable_input, positions,
     return(kable_input)
   }
   if (kable_format == "html") {
-    return(add_indent_html(kable_input, positions, level_of_indent, all_cols, target_cols))
+    return(add_indent_html(
+      kable_input, positions, level_of_indent, all_cols, target_cols
+      ))
   }
   if (kable_format == "latex") {
-    return(add_indent_latex(kable_input, positions, level_of_indent, all_cols, target_cols))
+    return(add_indent_latex(
+      kable_input, positions, level_of_indent, all_cols, target_cols
+      ))
   }
 }
 
@@ -72,8 +76,9 @@ add_indent_latex <- function(kable_input, positions,
       })
       new_rowtext <- paste(unlist(new_rowtext), collapse = " & ")
     } else {
-      if (all(target_cols %in% seq_along(new_rowtext))) {
-        new_rowtext[target_cols] <- latex_indent_unit(new_rowtext[target_cols], level_of_indent)
+      if (all(target_cols %in% seq(table_info$ncol))) {
+        new_rowtext[target_cols] <- latex_indent_unit(
+          new_rowtext[target_cols], level_of_indent)
       } else {
         stop("There aren't that many columns in the row. Check target_cols in ",
          "add_indent_latex.")
@@ -104,7 +109,9 @@ add_indent_html <- function(kable_input, positions,
                             target_cols = 1) {
   kable_attrs <- attributes(kable_input)
 
-  kable_xml <- kable_as_xml(kable_input)
+  important_nodes <- read_kable_as_xml(kable_input)
+  body_node <- important_nodes$body
+  kable_xml <- important_nodes$table
   kable_tbody <- xml_tpart(kable_xml, "tbody")
   if (is.null(kable_tbody))
     return(kable_input)
@@ -124,7 +131,8 @@ add_indent_html <- function(kable_input, positions,
       node_to_edit <- xml_child(row_to_edit, j)
       if (!xml_has_attr(node_to_edit, "indentlevel")) {
         xml_attr(node_to_edit, "style") <- paste0(
-          xml_attr(node_to_edit, "style"), "padding-left: ",paste0(level_of_indent*2,"em;")
+          xml_attr(node_to_edit, "style"), "padding-left: ",
+          paste0(level_of_indent*2,"em;")
         )
         xml_attr(node_to_edit, "indentlevel") <- 1
       } else {
@@ -138,7 +146,7 @@ add_indent_html <- function(kable_input, positions,
       }
     }
   }
-  out <- as_kable_xml(kable_xml)
+  out <- as_kable_xml(body_node)
   attributes(out) <- kable_attrs
   if (!"kableExtra" %in% class(out)) class(out) <- c("kableExtra", class(out))
   return(out)

R/collapse_rows.R

@@ -88,7 +88,9 @@ collapse_rows <- function(kable_input, columns = NULL,
 
 collapse_rows_html <- function(kable_input, columns, valign, target) {
   kable_attrs <- attributes(kable_input)
-  kable_xml <- kable_as_xml(kable_input)
+  important_nodes <- read_kable_as_xml(kable_input)
+  body_node <- important_nodes$body
+  kable_xml <- important_nodes$table
   kable_tbody <- xml_tpart(kable_xml, "tbody")
   if (is.null(kable_tbody))
     return(kable_input)
@@ -124,7 +126,7 @@ collapse_rows_html <- function(kable_input, columns, valign, target) {
     }
   }
 
-  out <- as_kable_xml(kable_xml)
+  out <- as_kable_xml(body_node)
   kable_attrs$collapse_matrix <- collapse_matrix
   attributes(out) <- kable_attrs
   if (!"kableExtra" %in% class(out)) class(out) <- c("kableExtra", class(out))

R/column_spec.R

@@ -120,7 +120,9 @@ column_spec_html <- function(kable_input, column, width,
                              extra_css, include_thead,
                              link, new_tab, tooltip, popover, image) {
   kable_attrs <- attributes(kable_input)
-  kable_xml <- kable_as_xml(kable_input)
+  important_nodes <- read_kable_as_xml(kable_input)
+  body_node <- important_nodes$body
+  kable_xml <- important_nodes$table
   kable_tbody <- xml_tpart(kable_xml, "tbody")
   if (is.null(kable_tbody))
     return(kable_input)
@@ -210,7 +212,7 @@ column_spec_html <- function(kable_input, column, width,
     }
   }
 
-  out <- as_kable_xml(kable_xml)
+  out <- as_kable_xml(body_node)
   attributes(out) <- kable_attrs
   if (!"kableExtra" %in% class(out)) class(out) <- c("kableExtra", class(out))
   return(out)
@@ -404,7 +406,7 @@ column_spec_latex <- function(kable_input, column, width,
   }
 
   # issue #658: offset generates bad indices with single row tables
-  rows <- intersect(rows, seq_along(nrows))
+  rows <- intersect(rows, seq(nrows))
 
   for (i in rows) {
     target_row <- table_info$contents[i]

R/footnote.R

@@ -210,14 +210,16 @@ footnote_table_maker <- function(format, footnote_titles, footnote_contents,
 # HTML
 footnote_html <- function(kable_input, footnote_table, footnote_as_chunk) {
   kable_attrs <- attributes(kable_input)
-  kable_xml <- read_kable_as_xml(kable_input)
+  important_nodes <- read_kable_as_xml(kable_input)
+  body_node <- important_nodes$body
+  kable_xml <- important_nodes$table
 
   new_html_footnote <- html_tfoot_maker(footnote_table, footnote_as_chunk)
   xml_add_child(kable_xml, new_html_footnote)
   xml2::xml_set_attr(kable_xml, "style",
                      paste0(xml2::xml_attr(kable_xml, "style"),
                             "border-bottom: 0;"))
-  out <- as_kable_xml(kable_xml)
+  out <- as_kable_xml(body_node)
   attributes(out) <- kable_attrs
   if (!"kableExtra" %in% class(out)) class(out) <- c("kableExtra", class(out))
   return(out)
@@ -283,7 +285,7 @@ footnote_latex <- function(kable_input, footnote_table, footnote_as_chunk,
                         "}\n\\\\end{ThreePartTable}"),
                  out)
       if (table_info$booktabs) {
-        out <- sub("\\\\bottomrule", "\\\\bottomrule\n\\\\insertTableNotes", out)
+        out <- sub(bottomrule_regexp, "\\1\n\\\\insertTableNotes", out)
       } else {
         out <- sub("\\\\hline\n\\\\end\\{longtable\\}",
                    "\\\\hline\n\\\\insertTableNotes\n\\\\end\\{longtable\\}",
@@ -308,8 +310,8 @@ footnote_latex <- function(kable_input, footnote_table, footnote_as_chunk,
     }
   } else {
     if (table_info$booktabs) {
-      out <- sub("\\\\bottomrule",
-                 paste0("\\\\bottomrule\n", footnote_text), out)
+      out <- sub(bottomrule_regexp,
+                 paste0("\\1\n", footnote_text), out)
     } else {
       out <- sub(table_info$end_tabular,
                  paste0(footnote_text, "\n\\\\end{", table_info$tabular, "}"),

R/group_rows.R

@@ -143,7 +143,9 @@ group_rows_html <- function(kable_input, group_label, start_row, end_row,
                             bold, italic, monospace, underline, strikeout,
                             color, background) {
   kable_attrs <- attributes(kable_input)
-  kable_xml <- read_kable_as_xml(kable_input)
+  important_nodes <- read_kable_as_xml(kable_input)
+  body_node <- important_nodes$body
+  kable_xml <- important_nodes$table
   kable_tbody <- xml_tpart(kable_xml, "tbody")
   if (is.null(kable_tbody))
     return(kable_input)
@@ -215,7 +217,7 @@ group_rows_html <- function(kable_input, group_label, start_row, end_row,
   xml_add_sibling(starting_node, group_header_row, .where = "before")
 
   # add indentations to items
-  out <- as_kable_xml(kable_xml)
+  out <- as_kable_xml(body_node)
   attributes(out) <- kable_attrs
   attr(out, "group_header_rows") <- c(attr(out, "group_header_rows"), group_seq[1])
   if (indent) {

R/header_separate.R

@@ -42,7 +42,9 @@ header_separate <- function(kable_input, sep = "[^[:alnum:]]+", ...) {
 
 header_separate_html <- function(kable_input, sep, ...) {
   kable_attrs <- attributes(kable_input)
-  kable_xml <- kable_as_xml(kable_input)
+  important_nodes <- read_kable_as_xml(kable_input)
+  body_node <- important_nodes$body
+  kable_xml <- important_nodes$table
 
   kable_thead <- xml_tpart(kable_xml, "thead")
   if (is.null(kable_thead))
@@ -77,7 +79,7 @@ header_separate_html <- function(kable_input, sep, ...) {
                       new_header_row_one[[i]])
   }
 
-  out <- as_kable_xml(kable_xml)
+  out <- as_kable_xml(body_node)
   attributes(out) <- kable_attrs
   if (!"kableExtra" %in% class(out)) class(out) <- c("kableExtra", class(out))