inst/scripts/generate_theme_functions.R

In gadenbuie/xaringanthemer: Custom 'xaringan' CSS Themes

source(here::here("R/utils_theme-gen.R"))
load(here::here("R/sysdata.rda"))
# R/theme_settings.R contains element_description() and plural_elements()

setup_theme_function <- function(
  f_name = "style_xaringan",
  template = template_variables,
  ...,
  file = "",
  body = "  eval(parse(text = call_style_xaringan()))",
  theme_colors = NULL
) {
  if (file == "clip" && !requireNamespace("clipr", quietly = TRUE)) file <- ""
  f_body_theme_colors <- include_theme_colors(theme_colors)
  f_body <- c(
    "  # DO NOT EDIT - Generated from inst/scripts/generate_theme_functions.R",
    f_body_theme_colors,
    body
  )
  tv <- template
  f_def <- c(
    "# Generated by inst/scripts/generate_theme_functions.R: do not edit by hand\n",
    as.character(
      glue::glue_data(
        tv,
        "#' @param {variable} {description}. ",
        "Defaults to {gsub('[{{}}]', '`', default)}. ",
        "{element_description(element)}",
        "{describe_css_property(css_property)}",
        "{describe_css_variable(css_variable)}"
      )
    ),
    "#' @template theme_params",
    "#' @template style-usage",
    ...,
    glue::glue("{f_name} <- function("),
    as.character(
      glue::glue_data(
        tv,
        "  {variable} = {ifelse(!grepl('^[{].+[}]$', default), paste0('\"', default, '\"'), gsub('[{}]', '', default))},"
      )
    ),
    "  colors = NULL,",
    "  extra_css = NULL,",
    "  extra_fonts = NULL,",
    "  outfile = \"xaringan-themer.css\"",
    ") {"
  )
  if (!is.null(f_body)) f_def <- c(f_def, f_body, "}")
  if (file == "clip") {
    clipr::write_clip(f_def)
    message("Wrote ", f_name, " function signature to clipboard.")
  } else {
    cat(reflow_roxygen(f_def), sep = "\n", file = file)
    message("Wrote ", f_name, " to ", file)
  }
  invisible()
}

reflow_roxygen <- function(x) {
  is_roxy_tag <- grepl("^#' @", x)
  roxy_tags <- x[is_roxy_tag]
  roxy_tags <- sub("^#' ", "", roxy_tags)
  roxy_tags <- purrr::map_chr(
    roxy_tags,
    ~ paste(
      "#'", strwrap(
        pack_inline_code(.x),
        width = 77,
        exdent = 2
      ), collapse = "\n")
  )
  roxy_tags <- gsub("\u00A0", " ", roxy_tags)
  x[is_roxy_tag] <- roxy_tags
  x
}

pack_inline_code <- function(x) {
  stopifnot(length(x) == 1, is.character(x))
  x <- strsplit(x, "")[[1]]
  inline_code <- FALSE
  for (i in seq_along(x)) {
    if (identical(x[i], "`")) {
      inline_code <- !inline_code
    } else if (inline_code && identical(x[i], " ")) {
      x[i] <- "\u00A0"
    }
  }
  paste(x, collapse = "")
}

include_theme_colors <- function(theme_colors = NULL) {
  if (is.null(theme_colors)) return(NULL)
  unname <- glue::glue("{theme_colors} <- unname({theme_colors})")
  unname <- paste(unname, collapse = "\n  ")
  x <- glue::glue('{names(theme_colors)} = {theme_colors}')
  x <- paste(x, collapse = ", ")
  glue::glue("  {unname}\n  colors <- c({x}, colors)", .trim = FALSE)
}

# ---- Write Xaringan Theme Function ----
setup_theme_function(
  "style_xaringan",
  template_variables,
  "#' @template style_xaringan",
  "#' @export",
  body = paste0("  ", readLines(here::here("inst/scripts/style_xaringan_body.R"))),
  file = here::here("R/style_xaringan.R")
)

# ---- Monotone Light ----
setup_theme_function(
  "style_mono_light",
  template_mono_light,
  "#' @template style_mono_light",
  "#' @family Monotone themes",
  "#' @export",
  file = here::here("R/style_mono_light.R"),
  theme_colors = c(base = "base_color", white = "white_color", black = "black_color")
)

# ---- Monotone Dark ----
setup_theme_function(
  "style_mono_dark",
  template_mono_dark,
  "#' @template style_mono_dark",
  "#' @family Monotone themes",
  "#' @export",
  file = here::here("R/style_mono_dark.R"),
  theme_colors = c(base = "base_color", white = "white_color", black = "black_color")
)

# ---- Monotone Accent ----
setup_theme_function(
  "style_mono_accent",
  template_mono_accent,
  "#' @template style_mono_accent",
  "#' @family Monotone themes",
  "#' @export",
  file = here::here("R/style_mono_accent.R"),
  theme_colors = c(base = "base_color", white = "white_color", black = "black_color")
)

# ---- Monotone Accent Inverse ----
setup_theme_function(
  "style_mono_accent_inverse",
  template_mono_accent_inverse,
  "#' @template style_mono_accent_inverse",
  "#' @family Monotone themes",
  "#' @export",
  file = here::here("R/style_mono_accent_inverse.R"),
  theme_colors = c(base = "base_color", white = "white_color", black = "black_color")
)

# ---- Duotone ----
setup_theme_function(
  "style_duo",
  template_duo,
  "#' @template style_duo",
  "#' @family Duotone themes",
  "#' @export",
  file = here::here("R/style_duo.R"),
  theme_colors = c(primary = "primary_color", secondary = "secondary_color")
)

# ---- Duotone Accent ----
setup_theme_function(
  "style_duo_accent",
  template_duo_accent,
  "#' @template style_duo_accent",
  "#' @family Duotone themes",
  "#' @export",
  file = here::here("R/style_duo_accent.R"),
  theme_colors = c(primary = "primary_color", secondary = "secondary_color",
                   white = "white_color", black = "black_color")
)

# ---- Duotone Accent Inverse ----
setup_theme_function(
  "style_duo_accent_inverse",
  template_duo_accent_inverse,
  "#' @template style_duo_accent_inverse",
  "#' @family Duotone themes",
  "#' @export",
  file = here::here("R/style_duo_accent_inverse.R"),
  theme_colors = c(primary = "primary_color", secondary = "secondary_color",
                   white = "white_color", black = "black_color")
)

# ---- Solarized Light ----
setup_theme_function(
  "style_solarized_light",
  template_solarized_light,
  "#' @template style_solarized_light",
  "#' @family Solarized themes",
  "#' @export",
  file = here::here("R/style_solarized_light.R")
)

# ---- Solarized Dark ----
setup_theme_function(
  "style_solarized_dark",
  template_solarized_dark,
  "#' @template style_solarized_dark",
  "#' @family Solarized themes",
  "#' @export",
  file = here::here("R/style_solarized_dark.R")
)