tools/download_preset_fonts.R

In bslib: Custom 'Bootstrap' 'Sass' Themes for 'shiny' and 'rmarkdown'

library(stringr)

# if (Sys.getenv("RSTUDIO") == "1") {
#   stop("Please run this script from the command line: `Rscript tools/download_preset_fonts.R`")
# }

# TODO: make sure this isn't drastically different from 2.1 Mb
fonts_home <- file.path("inst", "fonts")
unlink(fonts_home, recursive = TRUE)
dir.create(fonts_home)

extract_first_group <- function(x, pattern) {
  matches <- regmatches(x, regexec(pattern, x))
  na.omit(sapply(matches, "[", 2))
}

# Google Fonts does browser sniffing to determine which font file type is appropriate.
# At the time of writing, woff2 is recommended for Chrome, and actually provides pretty
# good browser support (and compression), so we'll adopt it universally
# https://caniuse.com/woff2
request_headers <- c(
  "User-Agent" = "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/122.0.0.0 Safari/537.36"
)

download_and_copy_fonts <- function(theme, rule_file = "_bootswatch.scss") {
  theme_file <- file.path(theme, rule_file)

  if (!file.exists(theme_file)) {
    stop("Couldn't find '", rule_file, "' in ", theme)
  }

  theme_scss <- readLines(theme_file)

  web_font_path <- grep(
    "$web-font-path:",
    theme_scss,
    value = TRUE,
    fixed = TRUE
  )
  if (!length(web_font_path)) {
    return()
  }
  web_font_url <- strsplit(stringr::str_trim(web_font_path), "\\s+")[[1]][2]
  if (!length(web_font_url)) {
    warning(
      "Wasn't able to extract a url for $web-font-path from theme: ",
      theme
    )
    return()
  }
  web_font_url <- gsub('(^")|("$)', '', web_font_url)
  css_file <- file.path(theme, "font.css")
  download.file(
    utils::URLencode(web_font_url),
    css_file,
    method = "libcurl",
    headers = request_headers
  )
  css <- readLines(css_file)
  urls <- sass:::extract_group(css, "url\\(([^)]+)")
  basenames <- basename(urls)
  Map(
    function(url, nm) {
      if (!grepl("[.]woff2$", nm)) {
        stop("Expected a woff2 font file")
      }

      target <- file.path(fonts_home, nm)
      # The basename can sometimes be very long, and R CMD check
      # will complain if the target file is over 100 characters long,
      # so shorten it if necessary
      if (nchar(file.path("bslib", target)) > 100) {
        nm <- paste0(
          rlang::hash(tools::file_path_sans_ext(nm)),
          ".",
          tools::file_ext(nm)
        )
        target <- file.path(fonts_home, nm)
      }
      download.file(url, target, method = "libcurl", headers = request_headers)
      css <<- sub(url, file.path("fonts", nm), css, fixed = TRUE)
    },
    urls,
    basenames
  )
  writeLines(css, css_file)
  NULL
}

themes5 <- list.dirs(
  "inst/lib/bsw5/dist",
  recursive = FALSE,
  full.names = TRUE
)
themes4 <- list.dirs(
  "inst/lib/bsw4/dist",
  recursive = FALSE,
  full.names = TRUE
)
themes3 <- list.dirs(
  "inst/lib/bsw3",
  recursive = FALSE,
  full.names = TRUE
)
builtin5 <- list.dirs(
  "inst/builtin/bs5",
  recursive = FALSE,
  full.names = TRUE
)

invisible({
  lapply(themes5, download_and_copy_fonts)
  lapply(themes4, download_and_copy_fonts)
  lapply(themes3, download_and_copy_fonts)
})

lapply(builtin5, download_and_copy_fonts, rule_file = "_rules.scss")