1#' Create a Bootstrap theme
2#'
3#' @description
4#'
5#' Creates a Bootstrap theme object, where you can:
6#'
7#' * Choose a (major) Bootstrap `version`.
8#' * Choose a [Bootswatch theme](https://bootswatch.com) (optional).
9#' * Customize main colors and fonts via explicitly named arguments (e.g.,
10#'   `bg`, `fg`, `primary`, etc).
11#' * Customize other, lower-level, Bootstrap Sass variable defaults via `...`.
12#'
13#' To learn more about how to implement custom themes, as well as how to use them inside Shiny and R Markdown, [see here](https://rstudio.github.io/bslib/articles/bslib.html).
14#'
15#' @section Colors:
16#'
17#'  Colors may be provided in any format that [htmltools::parseCssColors()] can
18#'  understand. To control the vast majority of the ('grayscale') color
19#'  defaults, specify both the `fg` (foreground) and `bg` (background) colors.
20#'  The `primary` and `secondary` theme colors are also useful for accenting the
21#'  main grayscale colors in things like hyperlinks, tabset panels, and buttons.
22#'
23#' @section Fonts:
24#'
25#'  Use `base_font`, `code_font`, and `heading_font` to control the main
26#'  typefaces. These arguments set new defaults for the relevant `font-family`
27#'  CSS properties, but don't necessarily import the relevant font files. To
28#'  both set CSS properties _and_ import font files, consider using the various
29#'  [font_face()] helpers.
30#'
31#'  Each `*_font` argument may be collection of character vectors,
32#'  [font_google()]s, [font_link()]s and/or [font_face()]s. Note that a
33#'  character vector can have:
34#'    * A single unquoted name (e.g., `"Source Sans Pro"`).
35#'    * A single quoted name (e.g., `"'Source Sans Pro'"`).
36#'    * A comma-separated list of names w/ individual names quoted as necessary.
37#'      (e.g. `c("Open Sans", "'Source Sans Pro'", "'Helvetica Neue', Helvetica, sans-serif")`)
38#'
39#'  Since `font_google(..., local = TRUE)` guarantees that the client has access to
40#'  the font family, meaning it's relatively safe to specify just one font
41#'  family, for instance:
42#'
43#'  ```
44#'  bs_theme(base_font = font_google("Pacifico", local = TRUE))
45#'  ```
46#'
47#'  However, specifying multiple "fallback" font families is recommended,
48#'  especially when relying on remote and/or system fonts being available, for
49#'  instance. Fallback fonts are useful not only for handling missing fonts, but
50#'  also for handling a Flash of Invisible Text (FOIT) which can be quite
51#'  noticeable with remote web fonts on a slow internet connection.
52#'
53#'  ```
54#'  bs_theme(base_font = font_collection(font_google("Pacifico", local = FALSE), "Roboto", "sans-serif")
55#'  ````
56#'
57#' @param version The major version of Bootstrap to use (see [versions()]
58#'   for possible values). Defaults to the currently recommended version
59#'   for new projects (currently Bootstrap 4).
60#' @param bootswatch The name of a bootswatch theme (see [bootswatch_themes()]
61#'   for possible values). When provided to `bs_theme_update()`, any previous
62#'   Bootswatch theme is first removed before the new one is applied (use
63#'   `bootswatch = "default"` to effectively remove the Bootswatch theme).
64#' @param ... arguments passed along to [bs_add_variables()].
65#' @param bg A color string for the background.
66#' @param fg A color string for the foreground.
67#' @param primary A color to be used for hyperlinks, to indicate primary/default
68#'   actions, and to show active selection state in some Bootstrap components.
69#'   Generally a bold, saturated color that contrasts with the theme's base
70#'   colors.
71#' @param secondary A color for components and messages that don't need to stand
72#'   out. (Not supported in Bootstrap 3.)
73#' @param success A color for messages that indicate an operation has succeeded.
74#'   Typically green.
75#' @param info A color for messages that are informative but not critical.
76#'   Typically a shade of blue-green.
77#' @param warning A color for warning messages. Typically yellow.
78#' @param danger A color for errors. Typically red.
79#' @param base_font The default typeface.
80#' @param code_font The typeface to be used for code. Be sure this is monospace!
81#' @param heading_font The typeface to be used for heading elements.
82#' @param font_scale A scalar multiplier to apply to the base font size. For
83#'   example, a value of `1.5` scales font sizes to 150% and a value of `0.8`
84#'   scales to 80%. Must be a positive number.
85#'
86#' @return a [sass::sass_bundle()] (list-like) object.
87#'
88#' @references \url{https://rstudio.github.io/bslib/articles/bslib.html}
89#' @references \url{https://rstudio.github.io/sass/}
90#' @seealso [bs_add_variables()], [bs_theme_preview()]
91#' @examples
92#'
93#' theme <- bs_theme(
94#'   # Controls the default grayscale palette
95#'   bg = "#202123", fg = "#B8BCC2",
96#'   # Controls the accent (e.g., hyperlink, button, etc) colors
97#'   primary = "#EA80FC", secondary = "#48DAC6",
98#'   base_font = c("Grandstander", "sans-serif"),
99#'   code_font = c("Courier", "monospace"),
100#'   heading_font = "'Helvetica Neue', Helvetica, sans-serif",
101#'   # Can also add lower-level customization
102#'   "input-border-color" = "#EA80FC"
103#' )
104#' if (interactive()) {
105#'   bs_theme_preview(theme)
106#' }
107#'
108#' # Lower-level bs_add_*() functions allow you to work more
109#' # directly with the underlying Sass code
110#' theme <- bs_add_variables(theme, "my-class-color" = "red")
111#' theme <- bs_add_rules(theme, ".my-class { color: $my-class-color }")
112#'
113#' @export
114bs_theme <- function(version = version_default(), bootswatch = NULL, ...,
115                     bg = NULL, fg = NULL, primary = NULL, secondary = NULL,
116                     success = NULL, info = NULL, warning = NULL, danger = NULL,
117                     base_font = NULL, code_font = NULL, heading_font = NULL,
118                     font_scale = NULL) {
119
120  theme <- bs_bundle(
121    bs_theme_init(version, bootswatch),
122    bootstrap_bundle(version),
123    bootswatch_bundle(bootswatch, version)
124  )
125  bs_theme_update(
126    theme, ...,
127    bg = bg, fg = fg,
128    primary = primary,
129    secondary = secondary,
130    success = success,
131    info = info,
132    warning = warning,
133    danger = danger,
134    base_font = base_font,
135    code_font = code_font,
136    heading_font = heading_font,
137    font_scale = font_scale
138  )
139}
140
141#' @rdname bs_theme
142#' @param theme a [bs_theme()] object.
143#' @export
144bs_theme_update <- function(theme, ..., bootswatch = NULL, bg = NULL, fg = NULL,
145                            primary = NULL, secondary = NULL, success = NULL,
146                            info = NULL, warning = NULL, danger = NULL,
147                            base_font = NULL, code_font = NULL, heading_font = NULL,
148                            font_scale = NULL) {
149  assert_bs_theme(theme)
150
151  if (!is.null(bootswatch)) {
152    old_swatch <- theme_bootswatch(theme)
153    # You're only allowed one Bootswatch theme!
154    if (length(old_swatch)) {
155      theme <- bs_remove(theme, "bootswatch")
156      class(theme) <- setdiff(class(theme), bootswatch_class(old_swatch))
157    }
158    if (!identical(bootswatch, "default")) {
159      theme <- add_class(theme, bootswatch_class(bootswatch))
160      theme <- bs_bundle(theme, bootswatch_bundle(bootswatch, theme_version(theme)))
161    }
162  }
163  # See R/bs-theme-update.R for the implementation of these
164  theme <- bs_base_colors(theme, bg = bg, fg = fg)
165  theme <- bs_accent_colors(
166    theme, primary = primary, secondary = secondary, success = success,
167    info = info, warning = warning, danger = danger
168  )
169  theme <- bs_fonts(theme, base = base_font, code = code_font, heading = heading_font)
170  if (!is.null(font_scale)) {
171    stopifnot(is.numeric(font_scale) && length(font_scale) == 1)
172    theme <- bs_add_variables(
173      theme, "font-size-base" = paste(
174        font_scale, "*", bs_get_variables(theme, "font-size-base")
175      )
176    )
177  }
178  bs_add_variables(theme, ...)
179}
180
181#' @rdname bs_global_theme
182#' @export
183bs_global_theme_update <- function(..., bootswatch = NULL, bg = NULL, fg = NULL,
184                                   primary = NULL,  secondary = NULL, success = NULL,
185                                   info = NULL, warning = NULL, danger = NULL,
186                                   base_font = NULL, code_font = NULL, heading_font = NULL) {
187  theme <- assert_global_theme("bs_theme_global_update()")
188  bs_global_set(bs_theme_update(
189    theme, ...,
190    bg = bg, fg = fg,
191    primary = primary,
192    secondary = secondary,
193    success = success,
194    info = info,
195    warning = warning,
196    danger = danger,
197    base_font = base_font,
198    code_font = code_font,
199    heading_font = heading_font
200  ))
201}
202
203#' @rdname bs_theme
204#' @param x an object.
205#' @export
206is_bs_theme <- function(x) {
207  inherits(x, "bs_theme")
208}
209
210# Start an empty bundle with special classes that
211# theme_version() & theme_bootswatch() search for
212bs_theme_init <- function(version, bootswatch = NULL) {
213  add_class(
214    sass_layer(defaults = list("bootstrap-version" = version)),
215    c(
216      bootswatch_class(bootswatch),
217      paste0("bs_version_", version),
218      "bs_theme"
219    )
220  )
221}
222
223bootswatch_class <- function(bootswatch = NULL) {
224  if (is.null(bootswatch)) NULL else paste0("bs_bootswatch_", bootswatch)
225}
226
227assert_bs_theme <- function(theme) {
228  if (!is_bs_theme(theme)) {
229    stop("`theme` must be a `bs_theme()` object")
230  }
231  invisible(theme)
232}
233
234# -----------------------------------------------------------------
235# Core Bootstrap bundle
236# -----------------------------------------------------------------
237
238bootstrap_bundle <- function(version) {
239  pandoc_tables <- list(
240    # Pandoc uses align attribute to align content but BS4 styles take precedence...
241    # we may want to consider adopting this more generally in "strict" BS4 mode as well
242    ".table th[align=left] { text-align: left; }",
243    ".table th[align=right] { text-align: right; }",
244    ".table th[align=center] { text-align: center; }"
245  )
246
247  main_bundle <- switch_version(
248    version,
249    five = sass_bundle(
250      # Don't name this "core" bundle so it can't easily be removed
251      sass_layer(
252        functions = bs5_sass_files("functions"),
253        defaults = bs5_sass_files("variables"),
254        mixins = bs5_sass_files("mixins")
255      ),
256      # Returns a _named_ list of bundles (i.e., these should be easily removed)
257      !!!rule_bundles(
258        # Names here should match https://github.com/twbs/bs5/blob/master/scss/bootstrap.scss
259        bs5_sass_files(c(
260          "utilities",
261          "root", "reboot", "type", "images", "containers", "grid",
262          "tables", "forms", "buttons", "transitions", "dropdown",
263          "button-group", "nav", "navbar", "card", "accordion", "breadcrumb",
264          "pagination", "badge", "alert", "progress", "list-group", "close",
265          "toasts", "modal", "tooltip", "popover", "carousel", "spinners",
266          "offcanvas", "placeholders", "helpers", "utilities/api"
267        ))
268      ),
269      # Additions to BS5 that are always included (i.e., not a part of compatibility)
270      sass_layer(rules = pandoc_tables),
271      bs3compat = bs3compat_bundle()
272    ),
273    four = sass_bundle(
274      sass_layer(
275        functions = bs4_sass_files(c("deprecated", "functions")),
276        defaults = bs4_sass_files("variables"),
277        mixins = bs4_sass_files("mixins")
278      ),
279      # Returns a _named_ list of bundles (i.e., these should be easily removed)
280      !!!rule_bundles(
281        # Names here should match https://github.com/twbs/bs4/blob/master/scss/bootstrap.scss
282        bs4_sass_files(c(
283          "root", "reboot", "type", "images", "code", "grid", "tables",
284          "forms", "buttons", "transitions", "dropdown", "button-group",
285          "input-group", "custom-forms", "nav", "navbar", "card",
286          "breadcrumb", "pagination", "badge", "jumbotron", "alert",
287          "progress", "media", "list-group", "close", "toasts", "modal",
288          "tooltip", "popover", "carousel", "spinners", "utilities", "print"
289        ))
290      ),
291      # Additions to BS4 that are always included (i.e., not a part of compatibility)
292      sass_layer(rules = pandoc_tables),
293      bs3compat = bs3compat_bundle()
294    ),
295    three = sass_bundle(
296      sass_layer(
297        defaults = bs3_sass_files("variables"),
298        mixins = bs3_sass_files("mixins")
299      ),
300      # Should match https://github.com/twbs/bootstrap-sass/blob/master/assets/stylesheets/_bootstrap.scss
301      !!!rule_bundles(
302        bs3_sass_files(c(
303          "normalize", "print", "glyphicons", "scaffolding", "type", "code", "grid",
304          "tables", "forms", "buttons", "component-animations", "dropdowns", "button-groups",
305          "input-groups", "navs", "navbar", "breadcrumbs", "pagination", "pager", "labels",
306          "badges", "jumbotron", "thumbnails", "alerts", "progress-bars", "media",
307          "list-group", "panels", "responsive-embed", "wells", "close", "modals",
308          "tooltip", "popovers", "carousel", "utilities", "responsive-utilities"
309        ))
310      ),
311      accessibility = bs3_accessibility_bundle(),
312      glyphicon_font_files = sass_layer(
313        defaults = list("icon-font-path" = "'glyphicon-fonts/'"),
314        file_attachments = c(
315          "glyphicon-fonts" = lib_file("bs3", "assets", "fonts", "bootstrap")
316        )
317      )
318    )
319  )
320
321  sass_bundle(
322    main_bundle,
323    # color-contrast() was introduced in Bootstrap 5.
324    # We include our own version for a few reasons:
325    # 1. Easily turn off warnings options(bslib.color_contrast_warnings=F)
326    # 2. Allow Bootstrap 3 & 4 to use color-contrast() in variable definitions
327    # 3. Allow Bootstrap 3 & 4 to use bs_get_contrast()
328    sass_layer(
329      functions = sass_file(system_file("sass-utils/color-contrast.scss", package = "bslib"))
330    ),
331    # nav_spacer() CSS (can be removed)
332    nav_spacer = sass_layer(
333      rules = sass_file(system_file("nav-spacer/nav-spacer.scss", package = "bslib"))
334    )
335  )
336}
337
338
339bootstrap_javascript_map <- function(version) {
340  switch_version(
341    version,
342    five = lib_file("bs5", "dist", "js", "bootstrap.bundle.min.js.map"),
343    four = lib_file("bs4", "dist", "js", "bootstrap.bundle.min.js.map")
344  )
345}
346bootstrap_javascript <- function(version) {
347  switch_version(
348    version,
349    five = lib_file("bs5", "dist", "js", "bootstrap.bundle.min.js"),
350    four = lib_file("bs4", "dist", "js", "bootstrap.bundle.min.js"),
351    three = lib_file("bs3", "assets", "javascripts", "bootstrap.min.js")
352  )
353}
354
355
356# -----------------------------------------------------------------
357# BS3 compatibility bundle
358# -----------------------------------------------------------------
359
360bs3compat_bundle <- function() {
361  sass_layer(
362    defaults = sass_file(system_file("bs3compat", "_defaults.scss", package = "bslib")),
363    mixins = sass_file(system_file("bs3compat", "_declarations.scss", package = "bslib")),
364    rules = sass_file(system_file("bs3compat", "_rules.scss", package = "bslib")),
365    # Gyliphicon font files
366    file_attachments = c(
367      fonts = lib_file("bs3", "assets", "fonts")
368    ),
369    html_deps = htmltools::htmlDependency(
370      "bs3compat", packageVersion("bslib"),
371      package = "bslib",
372      src = "bs3compat/js",
373      script = c("transition.js", "tabs.js", "bs3compat.js")
374    )
375  )
376}
377
378# -----------------------------------------------------------------
379# BS3 accessibility bundle
380# -----------------------------------------------------------------
381
382bs3_accessibility_bundle <- function() {
383  sass_layer(
384    rules = sass_file(
385      system_file(
386        "lib", "bs-a11y-p",
387        "src", "sass", "bootstrap-accessibility.scss",
388        package = "bslib"
389      )
390    ),
391    html_deps = htmltools::htmlDependency(
392      "bootstrap-accessibility", version_accessibility,
393      package = "bslib", src = "lib/bs-a11y-p",
394      script = "plugins/js/bootstrap-accessibility.min.js",
395      all_files = FALSE
396    )
397  )
398}
399
400# -----------------------------------------------------------------
401# Bootswatch bundle
402# -----------------------------------------------------------------
403
404bootswatch_bundle <- function(bootswatch, version) {
405  if (!length(bootswatch) || isTRUE(bootswatch %in% c("default", "bootstrap"))) {
406    return(NULL)
407  }
408
409  bootswatch <- switch_version(
410    version,
411    four = {
412      switch(
413        bootswatch,
414        paper = {
415          message("Bootswatch 3 theme paper has been renamed to materia in version 4 (using that theme instead)")
416          "materia"
417        },
418        readable = {
419          message("Bootswatch 3 theme readable has been renamed to litera in version 4 (using that theme instead)")
420          "litera"
421        },
422        match.arg(bootswatch, bootswatch_themes(version))
423      )
424    },
425    default = match.arg(bootswatch, bootswatch_themes(version))
426  )
427
428  # Attach local font files, if necessary
429  font_css <- file.path(bootswatch_dist(version), bootswatch, "font.css")
430  attachments <- if (file.exists(font_css)) {
431    c(
432      "font.css" = font_css,
433      fonts = system_file("fonts", package = "bslib")
434    )
435  }
436
437  sass_bundle(
438    bootswatch = sass_layer(
439      file_attachments = attachments,
440      defaults = list(
441        # Use local fonts (this path is relative to the bootstrap HTML dependency dir)
442        '$web-font-path: "font.css" !default;',
443        bootswatch_sass_file(bootswatch, "variables", version),
444        # Unless we change navbarPage()'s markup, BS4+ will likely want BS3 compatibility
445        switch_version(
446          version, three = "", default = bs3compat_navbar_defaults(bootswatch)
447        )
448      ),
449      rules = list(
450        bootswatch_sass_file(bootswatch, "bootswatch", version),
451        # For some reason sketchy sets .dropdown-menu{overflow: hidden}
452        # but this prevents .dropdown-submenu from working properly
453        # https://github.com/rstudio/bootscss/blob/023d455/inst/node_modules/bootswatch/dist/sketchy/_bootswatch.scss#L204
454        if (identical(bootswatch, "sketchy")) ".dropdown-menu{ overflow: inherit; }" else "",
455        # TODO: is this really needed? Why isn't it listening to a Sass var?
456        if (identical(bootswatch, "lumen")) ".navbar.navbar-default {background-color: #f8f8f8 !important;}" else "",
457        # Several Bootswatch themes (e.g., zephyr, simplex, etc) add custom .btn-secondary
458        # rules that should also apply to .btn-default
459        ".btn-default:not(.btn-primary):not(.btn-info):not(.btn-success):not(.btn-warning):not(.btn-danger):not(.btn-dark):not(.btn-outline-primary):not(.btn-outline-info):not(.btn-outline-success):not(.btn-outline-warning):not(.btn-outline-danger):not(.btn-outline-dark) {
460          @extend .btn-secondary !optional;
461        }"
462      )
463    )
464  )
465}
466
467
468# Mappings from BS3 navbar classes to BS4
469bs3compat_navbar_defaults <- function(bootswatch) {
470  # Do nothing if this isn't a Bootswatch 3 theme
471  if (!bootswatch %in% c("materia", "litera", bootswatch_themes(3))) {
472    return("")
473  }
474
475  nav_classes <- switch(
476    bootswatch,
477    # https://bootswatch.com/cerulean/
478    # https://bootswatch.com/3/cerulean/
479    cerulean = list(
480      default = c("dark", "primary"),
481      inverse = c("dark", "dark")
482    ),
483    cosmo = list(
484      default = c("dark", "dark"),
485      inverse = c("dark", "primary")
486    ),
487    cyborg = list(
488      default = c("dark", "dark"),
489      inverse = c("dark", "secondary")
490    ),
491    darkly = list(
492      default = c("dark", "primary"),
493      inverse = c("light", "light")
494    ),
495    flatly = list(
496      default = c("light", "primary"),
497      inverse = c("dark", "secondary")
498    ),
499    journal = list(
500      default = c("light", "light"),
501      inverse = c("dark", "primary")
502    ),
503    lumen = list(
504      # Inline style is actually used for default's bg-color
505      default = c("light", "light"),
506      inverse = c("light", "light")
507    ),
508    # i.e., materia
509    paper = ,
510    materia = list(
511      default = c("light", "light"),
512      inverse = c("dark", "primary")
513    ),
514    readable = ,
515    litera = list(
516      # The default styling is totally different here, but I don't see a
517      # easy and consistent way to bring in the old styling
518      default = c("light", "light"),
519      inverse = c("light", "dark")
520    ),
521    sandstone = list(
522      default = c("dark", "primary"),
523      # technically speaking this background should be green, but dark looks
524      # better/more consistent with other stuff on the page
525      inverse = c("dark", "dark")
526    ),
527    simplex = list(
528      default = c("light", "light"),
529      inverse = c("dark", "primary")
530    ),
531    slate = list(
532      default = c("dark", "primary"),
533      inverse = c("dark", "light")
534    ),
535    spacelab = list(
536      default = c("light", "light"),
537      inverse = c("dark", "primary")
538    ),
539    superhero = list(
540      default = c("dark", "dark"),
541      inverse = c("dark", "primary")
542    ),
543    united = list(
544      default = c("dark", "primary"),
545      inverse = c("dark", "dark")
546    ),
547    yeti = list(
548      default = c("dark", "dark"),
549      inverse = c("dark", "primary")
550    ),
551    stop("Didn't recognize Bootswatch 3 theme: ", bootswatch, call. = FALSE)
552  )
553
554  list(
555    sprintf('$navbar-default-type: %s !default;', nav_classes$default[1]),
556    sprintf('$navbar-default-bg: %s !default;', nav_classes$default[2]),
557    sprintf('$navbar-inverse-type: %s !default;', nav_classes$inverse[1]),
558    sprintf('$navbar-inverse-bg: %s !default;', nav_classes$inverse[2])
559  )
560}
561