gt: Easily Create Presentation-Ready Display Tables

Documented in gtsave

#------------------------------------------------------------------------------#
#
#                /$$
#               | $$
#     /$$$$$$  /$$$$$$
#    /$$__  $$|_  $$_/
#   | $$  \ $$  | $$
#   | $$  | $$  | $$ /$$
#   |  $$$$$$$  |  $$$$/
#    \____  $$   \___/
#    /$$  \ $$
#   |  $$$$$$/
#    \______/
#
#  This file is part of the 'rstudio/gt' project.
#
#  Copyright (c) 2018-2024 gt authors
#
#  For full copyright and license information, please look at
#  https://gt.rstudio.com/LICENSE.html
#
#------------------------------------------------------------------------------#


# gt_save() --------------------------------------------------------------------
#' Save a **gt** table as a file
#'
#' @description
#'
#' `gtsave()` makes it easy to save a **gt** table to a file. The function
#' guesses the file type by the extension provided in the output filename,
#' producing either an HTML, PDF, PNG, LaTeX, RTF, or Word (.docx) file.
#'
#' @details
#'
#' Output filenames with either the `.html` or `.htm` extensions will produce an
#' HTML document. In this case, we can pass a `TRUE` or `FALSE` value to the
#' `inline_css` option to obtain an HTML document with inlined CSS styles (the
#' default is `FALSE`). More details on CSS inlining are available at
#' [as_raw_html()]. We can pass values to arguments in [htmltools::save_html()]
#' through the `...`. Those arguments are either `background` or `libdir`,
#' please refer to the **htmltools** documentation for more details on the use
#' of these arguments.
#'
#' If the output filename is expressed with the `.rtf` extension then an RTF
#' file will be generated. In this case, there is an option that can be passed
#' through `...`: `page_numbering`. This controls RTF document page numbering
#' and, by default, page numbering is not enabled (i.e., `page_numbering =
#' "none"`).
#'
#' We can create an image file based on the HTML version of the `gt` table. With
#' the filename extension `.png`, we get a PNG image file. A PDF document can be
#' generated by using the `.pdf` extension. This process is facilitated by the
#' **webshot2** package, so, this package needs to be installed before
#' attempting to save any table as an image file. There is the option of passing
#' values to the underlying [webshot2::webshot()] function through `...`. Some of
#' the more useful arguments for PNG saving are `zoom` (defaults to a scale
#' level of `2`) and `expand` (adds whitespace pixels around the cropped table
#' image, and has a default value of `5`), and `selector` (the default value is
#' `"table"`). There are several more options available so have a look at the
#' **webshot2** documentation for further details.
#'
#' If the output filename extension is either of `.tex`, `.ltx`, or `.rnw`, a
#' LaTeX document is produced. An output filename of `.rtf` will generate an RTF
#' document. The LaTeX and RTF saving functions don't have any options to pass
#' to `...`.
#'
#' If the output filename extension is `.docx`, a Word document file is
#' produced. This process is facilitated by the **rmarkdown** package, so this
#' package needs to be installed before attempting to save any table as a
#' `.docx` document.
#'
#' @inheritParams fmt_number
#'
#' @param filename *Output filename*
#'
#'   `scalar<character>` // **required**
#'
#'   The file name to create on disk. Ensure that an extension compatible with
#'   the output types is provided (`.html`, `.tex`, `.ltx`, `.rtf`, `.docx`). If
#'   a custom save function is provided then the file extension is disregarded.
#'
#' @param path *Output path*
#'
#'   `scalar<character>` // *default:* `NULL` (`optional`)
#'
#'   An optional path to which the file should be saved (combined with
#'   `filename`).
#'
#' @param ... *Additional options*
#'
#'   `<named arguments>`
#'
#'   All other options passed to the appropriate internal saving function.
#'
#' @return The file name (invisibly) if the export process is successful.
#'
#' @section Examples:
#'
#' Using a small subset of the [`gtcars`] dataset, we can create a **gt** table
#' with row labels. We'll add a stubhead label with the [tab_stubhead()]
#' function to describe what is in the stub.
#'
#' ```r
#' tab_1 <-
#'   gtcars |>
#'   dplyr::select(model, year, hp, trq) |>
#'   dplyr::slice(1:5) |>
#'   gt(rowname_col = "model") |>
#'   tab_stubhead(label = "car")
#' ```
#'
#' Export the **gt** table to an HTML file with inlined CSS (which is necessary
#' for including the table as part of an HTML email) using `gtsave()` and the
#' `inline_css = TRUE` option.
#'
#' ```r
#' tab_1 |> gtsave(filename = "tab_1.html", inline_css = TRUE)
#' ```
#'
#' By leaving out the `inline_css` option, we get a more conventional HTML file
#' with embedded CSS styles.
#'
#' ```r
#' tab_1 |> gtsave(filename = "tab_1.html")
#' ```
#'
#' Saving as a PNG file results in a cropped image of an HTML table. The amount
#' of whitespace can be set with the `expand` option.
#'
#' ```r
#' tab_1 |> gtsave("tab_1.png", expand = 10)
#' ```
#'
#' Any use of the `.tex`, `.ltx`, or `.rnw` will result in the output of a LaTeX
#' document.
#'
#' ```r
#' tab_1 |> gtsave("tab_1.tex")
#' ```
#'
#' With the `.rtf` extension, we'll get an RTF document.
#'
#' ```r
#' tab_1 |> gtsave("tab_1.rtf")
#'
#' ```
#' With the `.docx` extension, we'll get a word/docx document.
#'
#' ```r
#' tab_1 |> gtsave("tab_1.docx")
#' ```
#'
#' @family table export functions
#' @section Function ID:
#' 13-1
#'
#' @section Function Introduced:
#' `v0.2.0.5` (March 31, 2020)
#'
#' @export
gtsave <- function(
    data,
    filename,
    path = NULL,
    ...
) {

  # Perform input object validation
  stop_if_not_gt_tbl_or_group(data = data)

  # Get the lowercased file extension
  file_ext <- gtsave_file_ext(filename)

  # Stop function if a file extension is not provided
  if (file_ext == "") {

    cli::cli_abort(c(
      "A file extension is required in the provided filename.",
      "i" = "We can use:",
      "*" = "`.html`, `.htm` (HTML file)",
      "*" = "`.png`          (PNG file)",
      "*" = "`.pdf`          (PDF file)",
      "*" = "`.tex`, `.rnw`  (LaTeX file)",
      "*" = "`.rtf`          (RTF file)",
      "*" = "`.docx`         (Word file)"
    ))
  }

  # Use the appropriate save function based
  # on the filename extension
  switch(
    file_ext,
    "htm" = ,
    "html" = gt_save_html(data = data, filename, path, ...),
    "ltx" = , # We don't verbally support using `ltx`
    "rnw" = ,
    "tex" = gt_save_latex(data = data, filename, path, ...),
    "rtf" = gt_save_rtf(data = data, filename, path, ...),
    "png" = ,
    "pdf" = gt_save_webshot(data = data, filename, path, ...),
    "docx" = gt_save_docx(data = data, filename, path, ...),
    {
      cli::cli_abort(c(
        "The file extension supplied (`.{file_ext}`) cannot be used.",
        "i" = "We can use:",
        "*" = "`.html`, `.htm` (HTML file)",
        "*" = "`.png`          (PNG file)",
        "*" = "`.pdf`          (PDF file)",
        "*" = "`.tex`, `.rnw`  (LaTeX file)",
        "*" = "`.rtf`          (RTF file)",
        "*" = "`.docx`         (Word file)"
      ))
    }
  )
  if (!is.null(path)) {
    filename <- file.path(path, filename)
  }

  invisible(filename)
}

#' Saving function for an HTML file
#'
#' @noRd
gt_save_html <- function(
    data,
    filename,
    path = NULL,
    ...,
    inline_css = FALSE
) {

  filename <- gtsave_filename(path = path, filename = filename)

  if (is_gt_tbl(data = data)) {

    if (inline_css) {

      html <- as_raw_html(data, inline_css = inline_css)
      html <- htmltools::HTML(html)

    } else {

      html <- as.tags(data)
    }

    return(htmltools::save_html(html, filename, ...))

  } else if (is_gt_group(data = data)) {

    seq_tbls <- seq_len(nrow(data$gt_tbls))

    html_tbls <- htmltools::tagList()

    for (i in seq_tbls) {

      html_tbl_i <-
        as_raw_html(grp_pull(data, which = i), inline_css = inline_css)
      
      html_tbls <- htmltools::tagList(html_tbls, html_tbl_i)
    }

    return(htmltools::save_html(html_tbls, filename, ...))
  }
}

#' Saving function for an image file via the webshot2 package
#'
#' @noRd
gt_save_webshot <- function(
    data,
    filename,
    path = NULL,
    ...,
    selector = "table",
    zoom = 2,
    expand = 5
) {

  if (is_gt_group(data = data)) {

    cli::cli_abort(c(
      "The `gtsave()` function cannot be used with `gt_group` objects.",
      "*" = "Alternatively, you can use `grp_pull()` -> `gtsave()` for each gt table."
    ))
  }

  filename <- gtsave_filename(path = path, filename = filename)

  # Create a temporary file with the `html` extension
  tempfile_ <- tempfile(fileext = ".html")

  # Reverse slashes on Windows filesystems
  tempfile_ <- normalizePath(tempfile_, "/", mustWork = FALSE)

  # Save gt table as HTML using the `gt_save_html()` function
  gt_save_html(
    data = data,
    filename = tempfile_,
    path = NULL
  )

  # Saving an image requires the webshot2 package; if it's
  # not present, stop with a message
  rlang::check_installed("webshot2", "to save gt tables as images.")

  # Save the image in the working directory
  webshot2::webshot(
    url = paste0("file:///", tempfile_),
    file = filename,
    selector = selector,
    zoom = zoom,
    expand = expand,
    ...
  )
}

#' Saving function for a LaTeX file
#'
#' @noRd
gt_save_latex <- function(
    data,
    filename,
    path = NULL,
    ...
) {

  filename <- gtsave_filename(path = path, filename = filename)

  if (is_gt_tbl(data = data)) {

    latex_lines <- as_latex(data = data)

  } else if (is_gt_group(data = data)) {

    latex_lines <- c()

    seq_tbls <- seq_len(nrow(data$gt_tbls))

    for (i in seq_tbls) {

      latex_lines_i <- as_latex(grp_pull(data, which = i))

      latex_lines <- c(latex_lines, latex_lines_i)
    }

    latex_lines <-
      paste(
        latex_lines,
        collapse = "\n\\newpage\n\n"
      )
  }

  writeLines(text = latex_lines, con = filename)
}

#' Saving function for an RTF file
#'
#' @noRd
gt_save_rtf <- function(
    data,
    filename,
    path = NULL,
    ...
) {

  filename <- gtsave_filename(path = path, filename = filename)

  if (is_gt_tbl(data = data)) {

    rtf_lines <- as_rtf(data = data)

  } else if (is_gt_group(data = data)) {

    rtf_lines <- NULL # same as c()

    rtf_open <-
      as_rtf(
        grp_pull(data, which = 1),
        incl_open = TRUE,
        incl_header = TRUE,
        incl_page_info = TRUE,
        incl_body = FALSE,
        incl_close = FALSE
      )

    seq_tbls <- seq_len(nrow(data$gt_tbls))

    for (i in seq_tbls) {

      rtf_lines_i <-
        as_rtf(
          grp_pull(data, which = i),
          incl_open = FALSE,
          incl_header = FALSE,
          incl_page_info = FALSE,
          incl_body = TRUE,
          incl_close = FALSE
        )

      rtf_lines <- c(rtf_lines, rtf_lines_i)
    }

    rtf_lines_combined <-
      paste(
        rtf_lines,
        collapse = "\n{\\pard\\fs2\\par}\\page{\\pard\\fs2\\par}\n"
      )

    rtf_lines <- paste0(rtf_open, rtf_lines_combined, "}")
  }

  # Remove the comments specific to knitr since this will be a standalone
  # document not dependent on the knitr package
  rtf_lines <-
    gsub("!!!!!RAW-KNITR-CONTENT|RAW-KNITR-CONTENT!!!!!", "", rtf_lines)

  writeLines(rtf_lines, con = filename)
}

#' Saving function for a Word (docx) file
#'
#' @noRd
gt_save_docx <- function(
    data,
    filename,
    path = NULL,
    ...,
    open = rlang::is_interactive()
) {

  # Because creation of a .docx container is somewhat difficult, we
  # require the rmarkdown package to be installed to generate this
  # type of output
  rlang::check_installed("rmarkdown", "to save gt tables as Word documents.")

  filename <- gtsave_filename(path = path, filename = filename)

  if (is_gt_tbl(data = data)) {

    word_md_text <-
      paste0(
        c(
          "```{=openxml}",
          enc2utf8(as_word(data = data)),
          "```",
          ""),
        collapse = "\n"
      )

  } else if (is_gt_group(data = data)) {

    word_tbls <- NULL

    seq_tbls <- seq_len(nrow(data$gt_tbls))

    for (i in seq_tbls) {
      word_tbl_i <- as_word(grp_pull(data, which = i))
      word_tbls <- c(word_tbls, word_tbl_i)
    }

    word_tbls_combined <-
      paste(
        word_tbls,
        collapse = "\n\n<w:p><w:r><w:br w:type=\"page\" /></w:r></w:p>\n\n"
      )

    word_md_text <-
      paste0(
        c(
          "```{=openxml}",
          enc2utf8(word_tbls_combined),
          "```",
          ""),
        collapse = "\n"
      )
  }

  word_md_file <- tempfile(fileext = ".md")

  writeChar(
    iconv(word_md_text, to = "UTF-8"),
    con = word_md_file
  )

  rmarkdown::pandoc_convert(
    input = word_md_file,
    output = filename
  )

  if (needs_gt_as_word_post_processing(word_md_text)) {
    gt_as_word_post_processing(path = filename)
  }
}

#' Get the lowercase extension from a filename
#'
#' @noRd
gtsave_file_ext <- function(filename) {
  tolower(tools::file_ext(filename))
}

#' Combine `path` with `filename` and normalize the path
#'
#' @noRd
gtsave_filename <- function(path, filename) {

  path <- path %||% "."

  # The use of `fs::path_abs()` works around
  # the saving code in `htmltools::save_html()`
  # See rstudio/htmltools#165 for more details
  as.character(
    fs::path_expand(
      fs::path_abs(
        path = filename,
        start = path
      )
    )
  )
}