Merge remote-tracking branch 'dmurdock/toKable' into dev

R/kableExtra-package.R

@@ -58,7 +58,7 @@
 #' @importFrom stringr fixed str_count str_split str_match str_detect str_match_all
 #' str_extract str_replace_all str_trim str_extract_all str_sub str_replace
 #' @importFrom xml2 read_xml xml_attr xml_has_attr xml_attr<- read_html
-#' xml_child xml_children xml_name xml_add_sibling xml_add_child xml_text
+#' xml_child xml_children xml_name xml_add_sibling xml_add_child xml_text xml_length
 #' xml_remove write_xml xml_text<- xml_length
 #' @importFrom rvest html_table
 #' @importFrom knitr knit_meta_add include_graphics knit_print asis_output kable

R/kable_styling.R

@@ -214,7 +214,8 @@ htmlTable_styling <- function(kable_input,
   }
   kable_attrs <- attributes(kable_input)
   kable_xml <- read_kable_as_xml(kable_input)
-
+  pre <- attr(kable_xml, "pre")
+  post <- attr(kable_xml, "post")
   # Modify class
   bootstrap_options <- match.arg(
     bootstrap_options,
@@ -296,7 +297,7 @@ htmlTable_styling <- function(kable_input,
     }
   }
 
-  out <- as_kable_xml(kable_xml)
+  out <- as_kable_xml(kable_xml, pre, post)
   if (protect_latex) {
     out <- replace_latex_in_kable(out, kable_attrs$extracted_latex)
     kable_attrs$extracted_latex <- NULL

R/util.R

@@ -67,14 +67,45 @@ regex_escape <- function(x, double_backslash = FALSE) {
   return(x)
 }
 
-as_kable_xml <- function(x) {
-  out <- structure(as.character(x), format = "html", class = "knitr_kable")
+as_kable_xml <- function(x, pre = NULL, post = NULL) {
+  out <- structure(paste(c(pre, as.character(x), post), collapse = "\n"),
+                   format = "html", class = "knitr_kable")
   return(out)
 }
 
+is_html_table <- function(x) {
+  xml_length(x) == 1 &&
+    xml_name(xml_child(x, 1)) == "table"
+}
+
+child_to_character <- function(x) {
+  result <- character()
+  n <- xml_length(x)
+  for (i in seq_len(n)) {
+    if (xml_name(xml_child(x, i)) != "meta")
+      result <- c(result, as.character(xml_child(x, i)))
+  }
+  result
+}
+
 read_kable_as_xml <- function(x) {
   kable_html <- read_html(as.character(x), options = c("RECOVER", "NOERROR"))
-  xml_child(xml_child(kable_html, 1), 1)
+  children <- lapply(seq_len(xml_length(kable_html)),
+                     function(num) xml_child(kable_html, num))
+  pre <- character(0)
+  post <- character(0)
+  result <- list()
+  for (i in seq_along(children)) {
+    if (!is_html_table(children[[i]]))
+      pre <- c(pre, child_to_character(children[[i]]))
+    else {
+      result <- xml_child(children[[i]], 1)
+      for (j in seq_along(children)[-seq_len(i)])
+        post <- c(post, child_to_character(children[[i]]))
+      break;
+    }
+  }
+  structure(result, pre = pre, post = post)
 }
 
 #' LaTeX Packages