R/knitr.R

In huxtable: Easily Create and Style Tables for LaTeX, HTML and Other Formats

# knitr-related functions --------------------------------------------------------------------------


#' Print a huxtable within knitr
#'
#' @param x A huxtable.
#' @param options Not used.
#' @param ... Not used.
#'
#' @details
#' knitr calls [knitr::knit_print()] on objects when they are printed in a knitr (or RMarkdown) document.
#' The method for `huxtable` objects guesses the appropriate output format
#' (including Typst documents when using the `typst` package) and
#' prints itself out appropriately. You can override the output format by setting
#' `options("huxtable.knitr_output_format")`.
#'
#' @family knit_print
#' @seealso [huxtable-options]
knit_print.huxtable <- function(x, options, ...) {
  # guess... runs assert_package for knitr
  of <- getOption("huxtable.knitr_output_format", guess_knitr_output_format())
  call_name <- switch(of,
    latex = "to_latex",
    html = "to_html",
    pptx = ,
    docx = "as_flextable",
    md = "to_md",
    screen = "to_screen",
    rtf = "to_rtf",
    typst = "to_typst",
    { # default
      warning(glue::glue(
        'Unrecognized output format "{of}". Using `to_screen` to print huxtables.\n',
        'Set options("huxtable.knitr_output_format") manually to ',
        '"latex", "html", "rtf", "docx", "pptx", "md", "typst" or "screen".'
      ))
      "to_screen"
    }
  )

  res <- do.call(call_name, list(x))

  res <- switch(of,
    latex = {
      latex_deps <- report_latex_dependencies(quiet = TRUE)
      tenv <- tabular_environment(x)
      if (tenv %in% c("tabulary", "longtable")) {
        latex_deps <- c(latex_deps, list(rmarkdown::latex_dependency(tenv)))
      }
      knitr::asis_output(res, meta = latex_deps)
    },
    html = knitr::asis_output(
      htmltools::htmlPreserve(res)
    ),
    rtf = knitr::raw_output(res),
    pptx = ,
    docx = knitr::knit_print(res),
    typst = knitr::asis_output(res),
    knitr::asis_output(res)
  )

  return(res)
}

# see zzz.R
#' Print data frames in knitr using huxtable
#'
#' @inherit knit_print.huxtable params
#'
#' @details
#' `huxtable` defines a `knit_print` method for `data.frame`s. This converts the data frame
#' to a huxtable, with `add_colnames = TRUE`, themes it using [theme_plain()] and prints it.
#' It also tries to set a few intelligent defaults, e.g. wrapping long columns and setting
#' an appropriate width.
#' To turn this behaviour off, set `options(huxtable.knit_print_df = FALSE)`. To change the theme, set
#' `options("huxtable.knit_print_df_theme")` to a one-argument function which should return the huxtable.
#'
#' @family knit_print
#' @seealso [huxtable-options]
#' @examples
#' \dontrun{
#' # in your knitr document
#' mytheme <- function(ht) {
#'   ht <- set_all_borders(ht, 0.4)
#'   ht <- set_all_border_colors(
#'     ht,
#'     "darkgreen"
#'   )
#'   ht <- set_background_color(
#'     ht,
#'     evens, odds, "salmon"
#'   )
#'   ht
#' }
#'
#' options(
#'   huxtable.knit_print_df_theme = mytheme
#' )
#' # groovy!
#' data.frame(
#'   a = 1:5,
#'   b = 1:5
#' )
#' }
knit_print.data.frame <- function(x, options, ...) {
  # the FALSE default is so that this does not get called unless
  # huxtable has been explicitly attached
  if (!isTRUE(getOption("huxtable.knit_print_df", FALSE))) {
    NextMethod() # probably calls knit_print.default
  } else {
    ht <- as_huxtable(x)
    df_theme <- getOption("huxtable.knit_print_df_theme", theme_plain)
    assert_that(is.function(df_theme))
    ht <- df_theme(ht)
    # we are now jumping down the class hierarchy, so do this rather than NextMethod():
    knitr::knit_print(ht)
  }
}


#' Guess knitr output format
#'
#' Convenience function which tries to guess the ultimate output from knitr and rmarkdown.
#'
#' @return "html", "latex", "typst", or something else. If we are not in a knitr document,
#'   returns an empty string.
#' @export
#'
#' @examples
#' \dontrun{
#' # in a knitr document
#' guess_knitr_output_format()
#' }
guess_knitr_output_format <- function() {
  # knitr::is_html_output doesn't work in .Rhtml files
  assert_package("guess_knitr_output_format", "knitr")
  assert_package("guess_knitr_output_format", "rmarkdown")
  of <- knitr::opts_knit$get("out.format")
  if (is.null(of) || of == "markdown") {
    of <- knitr::opts_knit$get("rmarkdown.pandoc.to")
    if (is.null(of)) {
      knit_in <- knitr::current_input()
      if (is.null(knit_in)) {
        return("")
      }
      of <- rmarkdown::default_output_format(knit_in)
      of <- of$name
    }
  }
  if (of == "tufte_handout") of <- "latex"
  if (of == "tufte_html") of <- "html"
  of <- sub("_.*", "", of)
  if (grepl("typst", of, ignore.case = TRUE)) of <- "typst"
  if (of == "html4") of <- "html" # bookdown
  if (of %in% c("ioslides", "revealjs", "slidy")) of <- "html"
  if (of %in% c("beamer", "pdf")) of <- "latex"

  of
}