😎 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.

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