😎 Give your xaringan slides some style
Vous ne pouvez pas sélectionner plus de 25 sujets Les noms de sujets doivent commencer par une lettre ou un nombre, peuvent contenir des tirets ('-') et peuvent comporter jusqu'à 35 caractères.

80 lines
2.8KB

  1. # Make sure font names are wrapped in quotes if they have spaces
  2. f_args <- names(formals(sys.function()))
  3. for (var in f_args[grepl("font_family$", f_args)]) {
  4. eval(parse(text = paste0(var, "<-quote_elements_w_spaces(", var, ")")))
  5. }
  6. # Use font_..._google args to overwrite font args
  7. for (var in f_args[grepl("font_google$", f_args)]) {
  8. gf <- eval(parse(text = var))
  9. if (is.null(gf)) next
  10. if (!inherits(gf, "google_font")) {
  11. stop("`", var, "` must be set using `google_font()`.")
  12. }
  13. group <- strsplit(var, "_")[[1]][1]
  14. if (group == "text") {
  15. text_font_family <- gf$family
  16. text_font_weight <- gf$weights %||% "normal"
  17. text_font_weight <- substr(text_font_weight, 1, regexpr(",", text_font_weight)[1] - 1)
  18. text_font_url <- gf$url
  19. } else {
  20. for (thing in c("family", "url")) {
  21. eval(parse(text = paste0(group, "_font_", thing, " <- gf$", thing )))
  22. }
  23. }
  24. }
  25. extra_font_imports <- if (is.null(extra_fonts)) "" else list2fonts(extra_fonts)
  26. extra_font_imports <- paste(extra_font_imports, collapse = "\n")
  27. # convert NA arguments to NULL
  28. for (var in f_args) {
  29. val <- eval(parse(text = var))
  30. if (is.null(val)) next
  31. val <- val[!is.na(val)]
  32. is_na <- length(val) == 0
  33. if (is_na) assign(var, NULL)
  34. }
  35. # prepare variables for template
  36. body_font_family <- paste(c(text_font_family, text_font_family_fallback, text_font_base), collapse = ", ")
  37. background_size_fallback <- if (is.null(background_position)) "cover" else "100%"
  38. background_size <- background_image %??% (background_size %||% background_size_fallback)
  39. title_slide_background_size <- title_slide_background_size %||% (
  40. title_slide_background_image %??% "cover"
  41. )
  42. table_row_even_background_color <- table_row_even_background_color %||% background_color
  43. lapply(names(formals()), function(n) assign(n, get(n), envir = xaringanthemer_env))
  44. xaringanthemer_version <- utils::packageVersion("xaringanthemer")
  45. # prepare header background object
  46. needs_leading_dot <- !grepl("^\\.", header_background_ignore_classes)
  47. header_background_ignore_classes[needs_leading_dot] <- paste0(
  48. ".",
  49. header_background_ignore_classes[needs_leading_dot]
  50. )
  51. header_background_ignore_classes <- purrr::map(
  52. header_background_ignore_classes,
  53. ~ list(class = .)
  54. )
  55. header_background <- list(
  56. auto = header_background_auto,
  57. background_color = header_background_color,
  58. text_color = header_background_text_color,
  59. padding = header_background_padding,
  60. content_padding_top = header_background_content_padding_top,
  61. ignore = header_background_ignore_classes
  62. )
  63. colors <- prepare_colors(colors)
  64. tf <- system.file("resources", "template.css", package = "xaringanthemer")
  65. template <- readLines(tf, warn = FALSE)
  66. template <- paste(template, collapse = "\n")
  67. x <- whisker::whisker.render(template)
  68. writeLines(x, con = outfile)
  69. if (!is.null(extra_css)) style_extra_css(extra_css, outfile)
  70. outfile