R/print.R

In tinytable: Simple and Configurable Tables in 'HTML', 'LaTeX', 'Markdown', 'Word', 'PNG', 'PDF', and 'Typst' Formats

# knitr/raster screenshot output shared by knit_print.tinytable and
# print.tinytable. Returns NULL when `output` is neither "knitr" nor "raster".
print_png <- function(x, output) {
  if (identical(output, "knitr")) {
    assert_dependency("webshot2")
    assert_dependency("knitr")
    tmp <- tempfile(fileext = ".png")
    save_tt(x, tmp, overwrite = TRUE)
    return(knitr::include_graphics(tmp))
  }
  if (identical(output, "raster")) {
    assert_dependency("webshot2")
    assert_dependency("png")
    tmp <- tempfile(fileext = ".png")
    save_tt(x, tmp, overwrite = TRUE)
    img <- png::readPNG(tmp)
    grid::grid.newpage()
    grid::grid.raster(img)
    return(invisible(x))
  }
  NULL
}

# wrap raw output in a fenced block (or inline backticks for single-line
# strings) so pandoc passes it through untouched
# adapted from htmltools:::html_preserve, GPL3
knitr_fence <- function(out, format) {
  inline <- !grepl("\n", out, fixed = TRUE)
  if (inline) {
    sprintf("`%s`{=%s}", out, format)
  } else {
    sprintf("\n```{=%s}\n%s\n```\n", format, out)
  }
}

#' @exportS3Method xfun::record_print
record_print.tinytable <- function(x, ...) {
  if (!isTRUE(check_dependency("litedown"))) {
    return(x)
  }

  # litedown
  fmt <- tryCatch(litedown::get_context("format"), error = function(e) NULL)
  if (is.null(fmt)) {
    return(x)
  }

  if (!isTRUE(fmt %in% c("latex", "markdown", "html"))) {
    stop(
      "tinytable in litedown only supports latex, markdown, or html output",
      call. = FALSE
    )
  }

  x <- build_tt(x, output = fmt)
  out <- x@table_string

  out <- litedown::raw_text(out, fmt)
  return(out)
}

#' Print a tinytable object in knitr
#'
#' @keywords internal
#' @return A string with class `knit_asis` to be printed in Rmarkdown or Quarto documents.
#' @rawNamespace S3method(knitr::knit_print, tinytable)
#' @export
knit_print.tinytable <- function(
    x,
    output = get_option("tinytable_print_output", default = NULL),
    ...) {
  if (identical(output, "knitr") || identical(output, "raster")) {
    return(print_png(x, output))
  }

  # lazy styles get evaluated here, at the very end
  x <- build_tt(x, output = output)
  out <- x@table_string

  if (isTRUE(x@output %in% c("html", "typst"))) {
    out <- knitr_fence(out, x@output)
  }

  class(out) <- "knit_asis"
  return(out)
}

#' Print a tinytable object in pkgdown
#'
#' @param x A tinytable object
#' @param visible Whether the object is visible
#' @keywords internal
#' @return HTML output for pkgdown examples
#' @export
pkgdown_print.tinytable <- function(x, visible = TRUE) {
  if (!visible) {
    return(invisible())
  }

  # Build table with HTML output for pkgdown
  x <- build_tt(x, output = "html")
  out <- x@table_string

  # Return as browsable HTML (similar to knit_print pattern)
  htmlText <- paste(enc2utf8(out), collapse = " ")
  attr(htmlText, "html") <- TRUE
  attr(htmlText, "browsable_html") <- TRUE
  class(htmlText) <- c("html", "character")
  htmlText
}

#' Print, display, or convert a tinytable object
#'
#' This function is called automatically by `R` whenever a `tinytable` object is anprinted to the console or in an HTML viewer pane.
#'
#' @inheritParams tt
#' @param output Format in which a Tiny Table is printed. One of:
#' + `NULL`: automatically chosen based on context (see below).
#' + `"html"`: HTML table. In interactive mode, displayed in the viewer pane.
#' + `"latex"`: LaTeX table using tabularray.
#' + `"markdown"`: plain text markdown table.
#' + `"typst"`: Typst table.
#' + `"dataframe"`: formatted data frame.
#' + `"knitr"`: PNG screenshot via `webshot2`, returned through `knitr::include_graphics()`. Useful for embedding styled tables in Rmarkdown or Quarto documents. Requires the `webshot2` package.
#' + `"raster"`: PNG screenshot via `webshot2`, drawn on the graphics device via `grid::grid.raster()`. Useful for pkgdown `@examples` and README files, where the plot is captured as an image. Requires the `webshot2` and `png` packages. For README.Rmd files rendered with `rmarkdown::render()`, set `knitr::opts_chunk$set(fig.path = "man/figures/README-")` in a setup chunk so that pkgdown copies the images correctly.
#'
#' When `output` is `NULL`, the format is chosen automatically:
#' + When called from a script in non-interactive mode, the default is "markdown" (`interactive() == FALSE`).
#' + When called interactively in RStudio, the default is to display an HTML table in the viewer pane.
#' + When called interactively in another development environment, the default is "markdown".
#' + The default print output can be changed for an entire R session by calling: `options(tinytable_print_output = "html")`
#' + The default print output can be changed for a single `tinytable` object by modifying the `output` S4 slot.
#' @details
#' When printing to HTML in `interactive()` mode, a temporary file is created and `viewer()` is called to preview the file with the local browser (ex: Firefox or Chrome). The temporary file is then automatically cleaned up. On some operating systems, like some Linux distributions, browser do not have read access to the `/tmp/` directory. In such cases, users can specify a custom location to store temporary HTML files. Note that this prevents `tinytable` from automatically cleaning up temporary files automatically.
#'
#' `options(tinytable_tempdir = "/home/username/temp_directory")`
#' @param ... Other arguments are ignored.
#' @return launch a browser window or cat() the table to console.
#' @export
print.tinytable <- function(
    x,
    output = get_option("tinytable_print_output", default = NULL),
    ...) {
  x <- sanitize_output(x, output)

  if (identical(output, "knitr") || identical(output, "raster")) {
    return(print_png(x, output))
  }

  output <- infer_output(x)

  dir <- getOption("tinytable_tempdir", default = tempdir())
  dir <- sub("\\/$", "", dir)

  if (identical(output, "html")) {
    x@output_dir <- dir
    x@html_portable <- TRUE
  }


  x <- build_tt(x, output = output)

  tab <- x@table_string

  # lazy styles get evaluated here by build_tt(), at the very end
  if (identical(output, "dataframe")) {
    out <- x@data_body
    colnames(out) <- NULL
    if (x@ansi) {
      rows <- apply(out, 1, paste, collapse = " ")
      tabl <- paste(rows, collapse = "\n")
      cat("\n", tabl, "\n")
      return(invisible(out))
    } else {
      return(out)
    }
  } else if (output %in% c("latex", "typst", "markdown")) {
    cat(tab, "\n")
  } else if (output == "html") {
    if (is_rstudio_notebook()) {
      html_tinytable <- htmltools_browsable(tab)
      print(html_tinytable)
      return(invisible(NULL))
    }

    # need to change the output directory to a temporary directory
    # for plot_tt() inline plots to show up in RStudio
    random_name <- paste0(get_id("tinytable_"), ".html")
    htmlFile <- path.expand(normalizePath(file.path(dir, random_name), mustWork = FALSE))
    # on.exit(unlink(htmlFile))
    cat(tab, file = htmlFile)

    if (interactive()) {
      msg <- "Please choose a default browser with:

      options(browser = 'firefox')
      "
      if (identical(getOption("browser"), "")) {
        stop(msg, call. = FALSE)
      }

      viewer <- getOption("viewer", utils::browseURL)
      viewer(htmlFile)
    } else {
      cat(tab, "\n")
    }
  }

  return(invisible(x))
}

setMethod("show", "tinytable", function(object) {
  print.tinytable(
    object,
    output = get_option("tinytable_print_output", default = NULL)
  )
})

# adapted from {htmltools} under GPL3
htmltools_browsable <- function(x) {
  htmlText <- paste(enc2utf8(x), collapse = " ")
  attr(htmlText, "html") <- TRUE
  attr(htmlText, "browsable_html") <- TRUE
  class(htmlText) <- c("html", "character")
  class(htmlText) <- "shiny.tag.list"
  htmlText
}