R/save_kable.R

#' Save kable to files
#'
#' @param x A piece of HTML code for tables, usually generated by kable and
#' kableExtra
#' @param file save to files. If the input table is in HTML and the output file
#' ends with `.png`, `.pdf` and `.jpeg`, `webshot` will be used to do the
#' conversion.
#' @param bs_theme Which Bootstrap theme to use
#' @param self_contained Will the files be self-contained?
#' @param extra_dependencies Additional HTML dependencies. For example,
#' `list(`
#' @param ... Additional variables being passed to `webshot::webshot`. This
#' is for HTML only.
#' @param latex_header_includes A character vector of extra LaTeX header stuff.
#' Each element is a row. You can have things like
#' `c("\\\\usepackage{threeparttable}", "\\\\usepackage{icons}")`  You could
#' probably add your language package here if you use non-English text in your
#' table, such as `\\\\usepackage[magyar]{babel}`.
#' @param keep_tex A T/F option to control if the latex file that is initially created
#' should be kept. Default is `FALSE`.
#'
#' @export
save_kable <- function(x, file,
                       bs_theme = "simplex", self_contained = TRUE,
                       extra_dependencies = NULL, ...,
                       latex_header_includes = NULL, keep_tex = FALSE) {
  if (!is.null(attr(x, "format")) && attr(x, "format") == "latex") {
    return(save_kable_latex(x, file, latex_header_includes, keep_tex))
  }
  return(save_kable_html(x, file, bs_theme, self_contained,
                         extra_dependencies, ...))
}

save_kable_html <- function(x, file, bs_theme, self_contained,
                            extra_dependencies, ...) {
  dependencies <- list(
    rmarkdown::html_dependency_jquery(),
    rmarkdown::html_dependency_bootstrap(theme = bs_theme),
    html_dependency_kePrint()
  )
  if (!is.null(extra_dependencies)) {
    dependencies <- append(dependencies, extra_dependencies)
  }

  html_header <- htmltools::tags$head(dependencies)
  html_table <- htmltools::HTML(as.character(x))
  html_result <- htmltools::tagList(html_header, html_table)

  # Use webshot if necessary
  if (tools::file_ext(file) %in% c("png", "jpg", "jpeg", "pdf")) {
    file_html <- paste0(tools::file_path_sans_ext(file), ".html")
    file.create(file_html)
    file_html <- normalizePath(file_html)
    file <- paste0(tools::file_path_sans_ext(file_html), ".",
                   tools::file_ext(file))
    htmltools::save_html(html_result, file = file_html)
    webshot::webshot(file_html, file, ...)
    if (tools::file_ext(file) == "pdf") {
      message("Note that HTML color may not be displayed on PDF properly.")
    }
    unlink(file_html)
    unlink(file.path(dirname(file_html), "lib"), recursive = TRUE)
    if (requireNamespace("magick", quietly = TRUE)) {
      img_rework <- magick::image_read(file)
      img_rework <- magick::image_trim(img_rework)
      img_info <- magick::image_info(img_rework)
      magick::image_write(img_rework, file)
      attr(file, "info") <- img_info
    } else {
      message("save_kable will have the best result with magick installed. ")
    }
  } else {
    file.create(file)
    file <- normalizePath(file)
    htmltools::save_html(html_result, file = file)
    if (self_contained) {
      remove_html_doc(file)
      rmarkdown::pandoc_self_contained_html(file, file)
      unlink(file.path(dirname(file), "lib"), recursive = TRUE)
    }
  }

  return(invisible(file))
}

remove_html_doc <- function(x){
  out <- paste(readLines(x)[-1], collapse = "\n")
  writeLines(out, x)
}

save_kable_latex <- function(x, file, latex_header_includes, keep_tex) {
  temp_tex <- c(
    "\\documentclass[border=1mm, preview]{standalone}",
    "\\usepackage[active,tightpage]{preview}",
    "\\usepackage{varwidth}",
    "\\usepackage{amssymb, amsmath}",
    "\\usepackage{ifxetex,ifluatex}",
    "\\usepackage{fixltx2e}",
    "\\usepackage{polyglossia}",
    latex_pkg_list(),
    "\\usepackage{graphicx}",
    "\\usepackage{xltxtra,xunicode}",
    latex_header_includes,
    "\\begin{document}",
    solve_enc(x),
    "\\end{document}"
  )
  temp_tex <- paste(temp_tex, collapse = "\n")

  temp_tex_file <- paste0(tools::file_path_sans_ext(file), ".tex")
  writeLines(temp_tex, temp_tex_file, useBytes = T)
  temp_tex_file <- normalizePath(temp_tex_file)
  file_no_ext <- tools::file_path_sans_ext(temp_tex_file)

  owd <- setwd(dirname(temp_tex_file))

  system(paste0("xelatex -interaction=batchmode ", temp_tex_file))
  if (!keep_tex) {
    temp_file_delete <- paste0(file_no_ext, c(".tex", ".aux", ".log"))
    unlink(temp_file_delete)
  }

  table_img_info <- NULL
  if (tools::file_ext(file) != "pdf") {
    table_img_pdf <- try(
      magick::image_read(paste0(file_no_ext, ".pdf"),
                         density = 300), silent = T)
    if (class(table_img_pdf) == "try-error") {
      stop("We hit an error when trying to use magick to read the generated ",
           "PDF file. You may check your magick installation and try to ",
           "use magick::image_read to read the PDF file manually. It's also ",
           "possible that you didn't have ghostscript installed.")
    }
    unlink(paste0(file_no_ext, ".pdf"))
    table_img <- magick::image_convert(table_img_pdf,
                                       tools::file_ext(file))
    table_img_info <- magick::image_info(table_img)
    magick::image_write(table_img,
                        paste0(file_no_ext, ".", tools::file_ext(file)))
  }

  setwd(owd)

  out <- paste0(file_no_ext, ".", tools::file_ext(file))
  attr(out, "info") <- table_img_info
  return(invisible(out))
}