Nothing
#' Creating Pretty HTML from R Markdown
#'
#' This function is an alternative to the \code{\link[rmarkdown]{html_document}}
#' and \code{\link[rmarkdown]{html_vignette}} formats to create HTML document
#' from R Markdown. It generates small yet pretty HTML pages that are suitable
#' for publishing project pages and package vignettes.
#' See the \href{https://prettydoc.statr.me/}{online documentation}
#' for more details.
#'
#' @param theme Character string to specify the document theme. Currently supported
#' themes are \code{"cayman"}, \code{"tactile"}, \code{"architect"},
#' \code{"leonids"}, and \code{"hpstr"}.
#' @param highlight Character string to specify the syntax highlight theme.
#' Supported values are \code{NULL} (use Pandoc default),
#' \code{"github"}, and \code{"vignette"}.
#' @param css Additional CSS file to be \strong{merged} in the document. It will
#' \strong{NOT} overwrite the CSS from the themes.
#' @param math The engine to render math expressions. Possible values are
#' \code{"mathjax"} and \code{"katex"}. The \code{katex} engines
#' supports offline (no internet connection) rendering of math expressions.
#' @param fig_retina The same argument in \code{\link[rmarkdown]{html_document}}
#' but with a different default value (\code{NULL} to disable
#' retina scaling)
#' @param keep_md Keep the markdown file generated by knitting.
#' This is the same argument in \code{\link[rmarkdown]{html_vignette}}.
#' @param readme Use this vignette as the package \file{README.md} file.
#' This is the same argument in \code{\link[rmarkdown]{html_vignette}}.
#' @param compressed_css Whether the compressed CSS should be used.
#' @param \dots Additional arguments passed to \code{\link[rmarkdown]{html_document}}.
#'
#' @return R Markdown output format to pass to \code{\link[rmarkdown]{render}}.
#' @author Yixuan Qiu <\url{https://statr.me}>
#' @examples
#' \dontrun{
#' doc = system.file("rmarkdown", "templates", "html_pretty_vignette",
#' "skeleton", "skeleton.Rmd", package = "prettydoc")
#' rmarkdown::render(doc, html_pretty(), output_dir = tempdir())
#' }
#' @export
#'
#'
html_pretty <- function(theme = "cayman",
highlight = NULL,
css = NULL,
math = c("mathjax", "katex"),
fig_retina = NULL,
keep_md = FALSE,
readme = FALSE,
compressed_css = TRUE,
...) {
################################################################################
#
# Some notes: To design our own output format, the most important part is to
# use a different CSS from html_document(), which can be done by passing the
# `css` paramter to Pandoc. html_vignette() is a good and simple example of
# designing new output format, and in fact html_pretty() is largely based on
# html_vignette() with some other features added in.
#
# The CSS used by html_pretty() consists of three parts: the theme CSS, the
# syntax highlight CSS, and the one provided by users. These three parts will
# be merged to generate the single final CSS file.
#
# However, there are some complexities here. Usually CSS also depends on
# external resources, such as fonts, images, etc. Therefore before we pass the
# `css` parameter to Pandoc, we need to copy these files into the proper
# directory. What's even more complicated is that the name of the directory
# is generated by knitr, so we do not know the actual path in advance.
#
# Fortunately, rmarkdown is very well designed, and we can use the hook
# pre_processor() to accomplish these tasks. This hook is invoked after
# document is knitted and before Pandoc is called. What we do inside the
# hook is to copy the resources (including the CSS file) to the directory,
# and pass the relative path of CSS to Pandoc.
#
################################################################################
## Directories for resources
css_dir <- system.file("resources", "css", package = "prettydoc")
hl_dir <- system.file("resources", "css", "highlight", package = "prettydoc")
font_dir <- system.file("resources", "fonts", package = "prettydoc")
img_dir <- system.file("resources", "images", package = "prettydoc")
js_dir <- system.file("resources", "js", package = "prettydoc")
tmpl_dir <- system.file("resources", "templates", package = "prettydoc")
## Obtain theme CSS
avail_themes <- gsub("\\.css$", "", list.files(css_dir, "\\.css$"))
avail_themes <- grep("\\.min$", avail_themes, value = TRUE, invert = TRUE)
theme <- as.character(theme)
if (!isTRUE(theme %in% avail_themes)) {
warning("theme not found, use default (cayman) instead")
theme <- "cayman"
}
theme_css <- file.path(css_dir, sprintf("%s%s.css", theme,
if (isTRUE(compressed_css)) ".min" else ""))
## Also theme template
avail_tmpl <- gsub("\\.html$", "", list.files(tmpl_dir, "\\.html$"))
if (!isTRUE(theme %in% avail_tmpl)) {
theme <- "cayman"
}
theme_tmpl <- file.path(tmpl_dir, sprintf("%s.html", theme))
## Final CSS file
## We first save it to a temporary file, and then copy it to the appropriate
## directory in the pre_processor() hook
final_css <- tempfile(fileext = ".css")
file.copy(theme_css, final_css)
## Merge KaTeX CSS if math == "katex"
math <- match.arg(math)
if (math == "katex") {
katex_css <- file.path(css_dir, "katex", "katex.min.css")
file.append(final_css, katex_css)
}
## Merge syntax highlight CSS
if (!is.null(highlight)) {
avail_hl <- gsub("\\.css$", "", list.files(hl_dir, "\\.css$"))
if (!isTRUE(highlight %in% avail_hl)) {
warning("highlight style not found, use default instead")
} else {
hl_css <- file.path(hl_dir, sprintf("%s.css", highlight))
file.append(final_css, hl_css)
}
}
## Merge user-supplied CSS file
if (!is.null(css)) {
file.append(final_css, css)
}
## Borrowed from html_vignette()
pre_knit <- function(input, ...) {
if (readme) {
rmarkdown::render(input,
output_format = "github_document",
output_options = list(html_preview = FALSE),
output_file = "README.md",
output_dir = dirname(dirname(input)),
quiet = TRUE)
}
}
## Hook function, invoked after document is knitted (so we know files_dir)
## and before Pandoc is called (so we can pass the `css` parameter)
pre_processor <- function(metadata, input_file, runtime, knit_meta,
files_dir, output_dir) {
if (!file.exists(files_dir))
dir.create(files_dir)
pandoc_flags <- c()
## Copy CSS and resources to files_dir
file.copy(img_dir, files_dir, recursive = TRUE)
if (math == "katex") {
file.copy(font_dir, files_dir, recursive = TRUE)
file.copy(js_dir, files_dir, recursive = TRUE)
## Pass files_dir to pandoc template
pandoc_flags <- c(pandoc_flags,
"--variable", sprintf("resource-dir=%s", files_dir),
"--variable", "katex")
} else {
## Create fonts folder
out_font_dir <- file.path(files_dir, "fonts")
if (!file.exists(out_font_dir))
dir.create(out_font_dir)
## Exclude KaTeX fonts
font_files <- grep("^KaTeX_.*", list.files(font_dir), value = TRUE, invert = TRUE)
font_files <- file.path(font_dir, font_files)
file.copy(font_files, out_font_dir)
}
doc_css <- file.path(files_dir, "style.css")
file.copy(final_css, doc_css, overwrite = TRUE)
## Paremeters passed to Pandoc
pandoc_flags <- c(pandoc_flags, "--css", doc_css)
pandoc_flags
}
## `self_contained` needs to be explicitly specified, otherwise it will be
## set to TRUE
extra_args <- list(...)
self_contained <- extra_args$self_contained
clean_supporting <- if (!is.null(self_contained)) self_contained else TRUE
res <- rmarkdown::output_format(
knitr = NULL,
pandoc = NULL,
keep_md = keep_md,
clean_supporting = clean_supporting,
pre_knit = pre_knit,
pre_processor = pre_processor,
## Note that here `theme` and `highlight` are just parameters to make
## the HTML document tiny
## The real `theme` and `highlight` passed to html_pretty() are
## reflected in the final CSS file. Here `css` is set to NULL, but
## it will be set in the pre_processor() hook
base_format = rmarkdown::html_document(fig_retina = fig_retina,
css = NULL,
theme = NULL,
highlight = "pygments",
...)
)
## We have to do this hack, sadly. :-|
## html_document() disables certain features (including MathJax) when
## we are using a template file other than default. I guess this is to
## avoid the incompatibility between templates and options. However,
## our templates only add a few <section> wrappers around existing
## elements, so it should be safe to override this restriction.
pandoc_args <- res$pandoc$args
pandoc_args[grep("^--template$", pandoc_args) + 1] <- theme_tmpl
res$pandoc$args <- pandoc_args
res
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.