Nothing
#' Helpers for importing web fonts
#'
#' @description
#'
#' Include font file(s) when defining a Sass variable that represents a CSS
#' `font-family` property.
#'
#' @details
#'
#' These helpers **must be used the named list approach to variable
#' definitions**, for example:
#'
#' ```
#' list(
#' list("font-variable" = font_google("Pacifico")),
#' list("body{font-family: $font-variable}")
#' )
#' ```
#'
#' @section Font fallbacks:
#'
#' By default, `font_google()` downloads, caches, and serves the relevant font
#' file(s) locally. By locally serving files, there's a guarantee that the font
#' can render in any client browser, even when the client doesn't have internet
#' access. However, when importing font files remotely (i.e., `font_google(...,
#' local = FALSE)` or `font_link()`), it's a good idea to provide fallback
#' font(s) in case the remote link isn't working (e.g., maybe the end user
#' doesn't have an internet connection). To provide fallback fonts, use
#' [font_collection()], for example:
#'
#' ```
#' pacifico <- font_google("Pacifico", local = FALSE)
#' as_sass(list(
#' list("font-variable" = font_collection(pacifico, "system-ui")),
#' list("body{font-family: $font-variable}")
#' ))
#' ```
#'
#' @section Default flags:
#'
#' These font helpers encourage best practice of adding a `!default` to Sass
#' variable definitions, but the flag may be removed via `font_collection()` if
#' desired.
#'
#' ```
#' as_sass(list("font-variable" = pacifico))
#' #> $font-variable: Pacifico !default;
#' as_sass(list("font-variable" = font_collection(pacifico, default_flag = F)))
#' #> $font-variable: Pacifico;
#' ```
#'
#' @section Serving non-Google fonts locally:
#'
#' Non-Google fonts may also be served locally with `font_face()`, but it
#' requires downloading font file(s) and pointing `src` to the right location
#' on disk. If you want `src` to be a relative file path (you almost certainly
#' do), then you'll need to mount that resource path using something like
#' [shiny::addResourcePath()] (for a shiny app) or `servr::httd()` (for static
#' HTML).
#'
#' @param family A character string with a _single_ font family name.
#' @param local Whether or not download and bundle local (woff2) font files.
#' @param cache A [sass::sass_file_cache()] object (or, more generally, a file
#' caching class with `$get_file()` and `$set_file()` methods). Set this
#' argument to `FALSE` or `NULL` to disable caching.
#' @param wght One of the following:
#' * `NULL`, the default weight for the `family`.
#' * A character string defining an [axis range](https://developers.google.com/fonts/docs/css2#axis_ranges)
#' * A numeric vector of desired font weight(s).
#' @param ital One of the following:
#' * `NULL`, the default `font-style` for the `family`.
#' * `0`, meaning `font-style: normal`
#' * `1`, meaning `font-style: italic`
#' * `c(0, 1)`, meaning both `normal` and `italic`
#' @param display the `font-display` `@font-face` property.
#'
#' @return a [sass_layer()] holding an [htmltools::htmlDependency()] which points
#' to the font files.
#'
#' @references <https://developers.google.com/fonts/docs/css2>
#' @references <https://developer.mozilla.org/en-US/docs/Web/CSS/@font-face>
#' @references <https://developer.mozilla.org/en-US/docs/Learn/CSS/Styling_text/Web_fonts>
#'
#' @export
#' @rdname font_face
#' @examples
#'
#' library(htmltools)
#'
#' my_font <- list("my-font" = font_google("Pacifico"))
#' hello <- tags$body(
#' "Hello",
#' tags$style(
#' sass(
#' list(
#' my_font,
#' list("body {font-family: $my-font}")
#' )
#' )
#' )
#' )
#'
#' if (interactive()) {
#' browsable(hello)
#' }
#'
#' # Three different yet equivalent ways of importing a remotely-hosted Google Font
#' a <- font_google("Crimson Pro", wght = "200..900", local = FALSE)
#' b <- font_link(
#' "Crimson Pro",
#' href = "https://fonts.googleapis.com/css2?family=Crimson+Pro:wght@200..900"
#' )
#' url <- "https://fonts.gstatic.com/s/crimsonpro/v13/q5uDsoa5M_tv7IihmnkabARboYF6CsKj.woff2"
#' c <- font_face(
#' family = "Crimson Pro",
#' style = "normal",
#' weight = "200 900",
#' src = paste0("url(", url, ") format('woff2')")
#' )
font_google <- function(family, local = TRUE,
cache = sass_file_cache(sass_cache_context_dir()),
wght = NULL, ital = NULL, display = c("swap", "auto", "block", "fallback", "optional")) {
stopifnot(is.logical(local))
if (!is.null(wght)) {
stopifnot(is.character(wght) || is.numeric(wght))
wght <- sort(wght)
}
if (!is.null(ital)) {
stopifnot(all(ital %in% c(0, 1)))
ital <- sort(ital)
}
display <- match.arg(display)
axis_rng <-
if (is.null(wght) && is.null(ital)) {
""
} else if (is.null(ital)) {
paste0(":wght@", paste0(wght, collapse = ";"))
} else if (is.null(wght)) {
paste0(":ital@", paste0(ital, collapse = ";"))
} else {
paste0(":ital,wght@", paste0(
apply(expand.grid(wght, ital)[, 2:1], 1, paste0, collapse = ","),
collapse = ";"
))
}
x <- list(
family = family,
local = isTRUE(local), cache = cache,
href = paste0(
"https://fonts.googleapis.com/css2?family=",
family, axis_rng, "&display=", display
)
)
dep_func <- if (x$local) font_dep_google_local else font_dep_link
font_object(x, dep_func)
}
#' @rdname font_face
#' @export
#' @param href A URL resource pointing to the font data.
font_link <- function(family, href) {
font_object(list(family = family, href = href), font_dep_link)
}
#' @rdname font_face
#' @export
#' @param src A character vector for the `src` `@font-face` property. Beware
#' that is character strings are taken verbatim, so careful quoting and/or URL
#' encoding may be required.
#' @param weight A character (or numeric) vector for the `font-weight`
#' `@font-face` property.
#' @param display A character vector for the `font-display` `@font-face`
#' property.
#' @param style A character vector for the `font-style` `@font-face` property.
#' @param stretch A character vector for the `font-stretch` `@font-face`
#' property.
#' @param variant A character vector for the `font-variant` `@font-face`
#' property.
#' @param unicode_range A character vector for `unicode-range` `@font-face`
#' property.
font_face <- function(family, src, weight = NULL, style = NULL,
display = c("swap", "auto", "block", "fallback", "optional"),
stretch = NULL, variant = NULL, unicode_range = NULL) {
x <- dropNulls(list(
family = quote_css_font_families(family),
src = src,
weight = weight,
style = style,
display = if (!is.null(display)) match.arg(display),
stretch = stretch,
variant = variant,
unicode_range = unicode_range
))
# Multiple src values are separated by "," (everything else by white space)
# TODO: src could accept a list of named lists which might give us the
# opportunity to handle quoting and encoding of URLs
for (prop in names(x)) {
collapse <- switch(prop, src = , unicode_range = ", ", " ")
x[[prop]] <- paste0(x[[prop]], collapse = collapse)
}
x$css <- font_face_css(x)
font_object(x, font_dep_face)
}
font_face_css <- function(x) {
props <- names(x)
font_prop <- !props %in% c("src", "unicode_range")
props[font_prop] <- paste0("font-", props[font_prop])
paste0(
"@font-face {\n",
paste0(" ", props, ": ", x, ";", collapse = "\n"),
"\n}"
)
}
font_object <- function(x, dep_func) {
stopifnot(is.function(dep_func))
if (!is_string(x$family)) {
stop(
"Font `family` definitions must be a character string (length 1).",
call. = FALSE
)
}
# Dependency functions want to use unquoted family name
new_font_collection(
families = x$family,
# Produce dependency at render-time (i.e., tagFunction())
# so the context-aware caching dir has the proper context
html_deps = tagFunction(function() dep_func(x))
)
}
#' @rdname font_face
#' @param ... a collection of `font_google()`, `font_link()`, `font_face()`, and/or character vector(s) (i.e., family names to include in the CSS `font-family` properly). Family names are automatically quoted as necessary.
#' @param default_flag whether or not to include a `!default` when converted to a Sass variable with [as_sass()].
#' @param quote whether or not to attempt automatic quoting of family names.
#' @export
font_collection <- function(..., default_flag = TRUE, quote = TRUE) {
fonts <- dropNulls(list2(...))
# Transform syntax like font_collection(google = "Pacifico")
# into font_collection(font_google("Pacifico"))
# the primary motication for doing this is to support a Rmd
# syntax like this (for bslib theming):
# ---
# theme:
# base_font:
# google: Pacifico
# ---
fonts <- Map(
names2(fonts), fonts,
f = function(nm, val) {
if (identical(nm, "")) return(val)
func <- known_font_helpers[[nm]] %||% rlang::abort(
paste0(
"Unsupported argument name: ", nm, ".\n",
"Did you want to try one of these names instead: ",
paste0(names(known_font_helpers), collapse = ", "), "?"
)
)
do.call(func, as.list(val))
}
)
families <- lapply(fonts, function(x) {
if (is_font_collection(x))
return(x$families)
if (is.character(x) && isTRUE(all(nzchar(x, keepNA = TRUE))))
return(x)
stop(
"`font_collection()` expects a collection of `font_google()`, `font_link()`, `font_face()`, and/or non-empty character strings.",
call. = FALSE
)
})
families <- unlist(families, recursive = FALSE, use.names = FALSE)
deps <- lapply(fonts, function(x) {
if (is_font_collection(x)) x$html_deps
})
new_font_collection(
families = families,
html_deps = unlist(deps, recursive = FALSE, use.names = FALSE),
default_flag = isTRUE(default_flag),
quote = quote
)
}
known_font_helpers <- list(
"google" = font_google,
"link" = font_link,
"face" = font_face,
"collection" = font_collection
)
new_font_collection <- function(families, html_deps, default_flag = TRUE, quote = TRUE) {
add_class(
list(
families = if (isTRUE(quote)) quote_css_font_families(families) else families,
html_deps = html_deps,
default_flag = default_flag
),
"font_collection"
)
}
#' @rdname font_face
#' @param x test whether `x` is a `font_collection()`, `font_google()`, `font_link()`, or `font_face()` object.
#' @export
is_font_collection <- function(x) {
inherits(x, "font_collection")
}
quote_css_font_families <- function(x) {
stopifnot(is.character(x))
quoted_contents <- c(
unlist(regmatches(x, gregexpr("'([^']*)'", x))),
unlist(regmatches(x, gregexpr('"([^"]*)"', x)))
)
if (any(grepl(",", quoted_contents))) {
x <- paste0(x, collapse = ", ")
warning(
"`sass::font_collection()` doesn't automatically quote CSS ",
"`font-family` names when they contain a ','. ",
"If fonts don't render properly, make sure family names are ",
"quoted properly: ", x,
call. = FALSE
)
return(x)
}
pieces <- trim_ws(unlist(strsplit(x, ",")))
# Are there non-alpha, non-dash characters? If so, then quote
needs_quote <- grepl("[^A-Za-z-]", pieces, perl = TRUE)
has_quote <- grepl("^'", pieces) | grepl('^"', pieces)
pieces <- ifelse(
needs_quote & !has_quote,
paste0("'", pieces, "'"),
pieces
)
paste0(pieces, collapse = ", ")
}
font_dep_name <- function(x) {
gsub("\\s+", "_", trim_ws(x$family))
}
#' @import htmltools
font_dep_face <- function(x) {
# TODO: memoise::memoise() this or do something similar
# to output_template() to reduce file redundancy?
src_dir <- tempfile()
dir.create(src_dir)
writeLines(x$css, file.path(src_dir, "font.css"))
htmlDependency(
font_dep_name(x), get_package_version("sass"),
src = src_dir,
stylesheet = "font.css",
all_files = FALSE
)
}
font_dep_link <- function(x) {
htmlDependency(
font_dep_name(x), get_package_version("sass"),
head = format(tags$link(
href = utils::URLencode(x$href),
rel = "stylesheet"
)),
# The src dir doesn't actually matter...this is just a way
# to pass along <link> tags as a dependency
src = tempdir(), all_files = FALSE
)
}
# -------------------------------------------------------
# Local dependency logic
# -------------------------------------------------------
# For our purposes, cache objects must support these methods.
is_cache_object <- function(x) {
# Use tryCatch in case the object does not support `$`.
tryCatch(
is.function(x$get_file) && is.function(x$set_file),
error = function(e) FALSE
)
}
resolve_cache <- function(cache) {
if (is_cache_object(cache)) return(cache)
list(
get_file = function(...) FALSE,
set_file = function(...) FALSE
)
}
font_dep_google_local <- function(x) {
# TODO: memoise::memoise() this or do something similar
# to output_template() to reduce file redundancy?
tmpdir <- tempfile()
dir.create(tmpdir, recursive = TRUE)
css_file <- file.path(tmpdir, "font.css")
x$cache <- resolve_cache(x$cache)
css_key <- hash_with_user_agent(x$href)
css_hit <- x$cache$get_file(css_key, css_file)
# Even if we have a cache hit on the CSS file, we may need
# to re-download font file(s) if they've been pruned from the cache
css <- if (css_hit) readLines(css_file) else read_gfont_url(x$href, css_file)
# basename() of these url()s contain a hash key of the font data
urls <- extract_group(css, "url\\(([^)]+)")
basenames <- basename(urls)
# If need be, download the font file(s) that the CSS imports,
# and modify the CSS to point to the local files
Map(function(url, nm) {
key <- hash_with_user_agent(nm)
f <- file.path(tmpdir, nm)
hit <- x$cache$get_file(key, f)
if (hit) return()
# In the event we have a CSS cache hit but miss here, url should actually be
# a local file. In that case, bust the CSS cache, and start over so we know
# where to find the font files
if (!grepl("^\\s*http", url)) {
x$cache$remove(css_key)
return(font_dep_google_local(x))
}
download_file(url, f)
x$cache$set_file(key, f)
css <<- sub(url, nm, css, fixed = TRUE)
}, urls, basenames)
# Cache the *modified* form of the CSS file
# (with the local file paths instead of remote URLs)
if (!css_hit) {
writeLines(css, css_file)
x$cache$set_file(css_key, css_file)
}
htmltools::htmlDependency(
font_dep_name(x), get_package_version("sass"),
src = dirname(css_file),
stylesheet = basename(css_file),
all_files = TRUE
)
}
# Request the relevant @font-face definitions for the font url
read_gfont_url <- function(url, file) {
download_file(
utils::URLencode(url), file,
headers = c("User-Agent" = gfont_user_agent())
)
readLines(file)
}
# Set the User-Agent to Chrome user-agent so get receive woff2 font files,
# which is now suitable for the browsers that we support
gfont_user_agent <- function() {
"Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/122.0.0.0 Safari/537.36"
}
# Incorporate the User-Agent request header in
# the cache key since that can influence the font file type.
# Note that in version >0.4.8 we switched from woff to woff2
# to help with unstable font file hyperlinks
hash_with_user_agent <- function(x) {
rlang::hash(paste0(x, gfont_user_agent()))
}
extract_group <- function(x, pattern, which = 1) {
matches <- regmatches(x, regexec(pattern, x))
na.omit(sapply(matches, "[", which + 1))
}
# similar to thematic:::download_file, but also translates headers to curl
#' @importFrom stats na.omit
#' @importFrom utils download.file packageVersion
download_file <- function(url, dest, headers = NULL, ...) {
if (is_installed("curl")) {
if (!curl::has_internet()) {
warning(
"Looks like you don't have internet access, which is needed to ",
"download and install Google Fonts files. Try either changing ",
"thematic::font_spec(), manually installing the relevant font, or ",
"trying again with internet access.",
call. = FALSE
)
}
handle <- curl::handle_setheaders(curl::new_handle(), .list = headers)
return(curl::curl_download(url, dest, handle = handle, quiet = FALSE, ...))
}
if (capabilities("libcurl")) {
return(download.file(url, dest, method = "libcurl", headers = headers, ...))
}
stop(
"Downloading Google Font files requires either the curl package or ",
"`capabilities('libcurl')`. ", call. = FALSE
)
}
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.