Merge branch 'main' into yaml-extension

NEWS.md

@@ -1,12 +1,15 @@
 # pkgdown (development version)
 
 * Anywhere you can use `_pkgdown.yml`, you can now use `_pkgdown.yaml` (#2244).
+* pkgdown no longer overrides the default selection colours. This improves accessibility for users who have set their own colours in their browser settings (#2139, @glin).
+* `build_article()` now escapes html characters in the title (#2286).
 * `build_article()` no longer generates the wrong source link when you build your site outside of the root directory (#2172).
 * `build_reference()` matches usage for S3 and S4 methods to the style used by R 4.0.0 and later (#2187).
 * `<source>` tags now have their `srcref` attributes tweaked in the same way that the `src` attributes of `<img>` tags are (#2402).
 * New translation for "Search site", the label applied to the search box for screenreaders. This was previously incorrectly labelled as "Toggle navigation" (#2320).
 * You can now choose where the search box is placed with the "search" navbar component. This has been documented for a very long time, but as far as I can tell, never worked (#2320). If you have made your own template with a custom `navbar`, you will need to remove the `<form>` with `role="search"` to avoid getting two search boxes.
 * The mobile version of pkgdown sites no longer has a scrollburglar (a small amount of horizontal scroll) (#2179, @netique).
+* The `template.bslib` item now also accepts a `bootswatch` key (@gadenbuie, #2483).
 
 # pkgdown 2.0.9
 

R/build-articles.R

@@ -174,6 +174,9 @@ build_articles <- function(pkg = ".",
                            override = list(),
                            preview = NA) {
   pkg <- section_init(pkg, depth = 1L, override = override)
+  check_bool(quiet)
+  check_bool(lazy)
+  check_number_whole(seed, allow_null = TRUE)
 
   if (nrow(pkg$vignettes) == 0L) {
     return(invisible())
@@ -248,7 +251,7 @@ build_article <- function(name,
   as_is <- isTRUE(purrr::pluck(front, "pkgdown", "as_is"))
 
   default_data <- list(
-    pagetitle = front$title,
+    pagetitle = escape_html(front$title),
     toc = toc <- front$toc %||% TRUE,
     opengraph = list(description = front$description %||% pkg$package),
     source = repo_source(pkg, input),

R/build-home.R

@@ -31,6 +31,8 @@ build_home <- function(pkg = ".",
                        quiet = TRUE) {
 
   pkg <- section_init(pkg, depth = 0L, override = override)
+  check_bool(quiet)
+
   cli::cli_rule("Building home")
   dir_create(pkg$dst_path)
 

R/build-news.R

@@ -117,6 +117,8 @@ build_news_multi <- function(pkg = ".") {
   )
 
   render_news <- function(version, file_out, contents) {
+    # Older, major, versions first on each page
+    # https://github.com/r-lib/pkgdown/issues/2285#issuecomment-2070966518
     render_page(
       pkg,
       "news",

R/build-reference.R

@@ -158,6 +158,12 @@ build_reference <- function(pkg = ".",
                             document = "DEPRECATED",
                             topics = NULL) {
   pkg <- section_init(pkg, depth = 1L, override = override)
+  check_bool(lazy)
+  check_bool(examples)
+  check_bool(run_dont_run)
+  check_number_whole(seed, allow_null = TRUE)
+  check_bool(devel)
+  check_character(topics, allow_null = TRUE)
 
   if (document != "DEPRECATED") {
     lifecycle::deprecate_warn(

R/build-tutorials.R

@@ -29,6 +29,7 @@
 #' @export
 build_tutorials <- function(pkg = ".", override = list(), preview = NA) {
   pkg <- section_init(pkg, depth = 1L, override = override)
+
   tutorials <- pkg$tutorials
 
   if (nrow(tutorials) == 0) {

R/build.R

@@ -330,6 +330,9 @@ build_site <- function(pkg = ".",
                        install = !devel,
                        document = "DEPRECATED") {
   pkg <- as_pkgdown(pkg, override = override)
+  check_bool(devel)
+  check_bool(new_process)
+  check_bool(install)
 
   if (document != "DEPRECATED") {
     lifecycle::deprecate_warn(

R/init.R

@@ -28,8 +28,7 @@ init_site <- function(pkg = ".") {
       "{.file {pkg$dst_path}} is non-empty and not built by pkgdown",
       "!" = "Make sure it contains no important information \\
              and use {.run pkgdown::clean_site()} to delete its contents."
-      ),
-      call = caller_env()
+      )
     )
   }
 

R/package.R

@@ -8,16 +8,18 @@
 #'   values in `_pkgdown.yml`
 #' @export
 as_pkgdown <- function(pkg = ".", override = list()) {
+  if (!is.list(override)) {
+    cli::cli_abort("{.arg override} must be a list, not {obj_type_friendly(override)}.")
+  }
+
   if (is_pkgdown(pkg)) {
     pkg$meta <- modify_list(pkg$meta, override)
     return(pkg)
   }
 
+  check_string(pkg)
   if (!dir_exists(pkg)) {
-    cli::cli_abort(
-      "{.file {pkg}} is not an existing directory",
-      call = caller_env()
-    )
+    cli::cli_abort("{.file {pkg}} is not an existing directory")
   }
 
   desc <- read_desc(pkg)

R/preview.R

@@ -5,6 +5,8 @@
 #' @export
 preview_site <- function(pkg = ".", path = ".", preview = NA) {
   pkg <- as_pkgdown(pkg)
+  check_string(path)
+  check_bool(preview, allow_na = TRUE)
 
   if (is.na(preview)) {
     preview <- interactive() && !is_testing()

R/rd-data.R

@@ -7,16 +7,6 @@ as_data.NULL <- function(x, ...) {
   NULL
 }
 
-# Usage -------------------------------------------------------------------
-
-#' @export
-as_data.tag_usage <- function(x, ...) {
-  text <- paste(flatten_text(x, ..., escape = FALSE), collapse = "\n")
-  text <- str_trim(text)
-
-  highlight_text(text)
-}
-
 # Sections ----------------------------------------------------------------
 
 parse_section <- function(x, title, ...) {

R/rd-html.R

@@ -192,28 +192,6 @@ as_html.tag_linkS4class <- function(x, ...) {
   a(text, href = href)
 }
 
-# Miscellaneous --------------------------------------------------------------
-
-#' @export
-as_html.tag_method <- function(x, ...) method_usage(x, "S3")
-#' @export
-as_html.tag_S3method <- function(x, ...) method_usage(x, "S3")
-#' @export
-as_html.tag_S4method <- function(x, ...) method_usage(x, "S4")
-
-method_usage <- function(x, type) {
-  fun <- as_html(x[[1]])
-  class <- as_html(x[[2]])
-
-  if (x[[2]] == "default") {
-    method <- sprintf(tr_("# Default %s method"), type)
-  } else {
-    method <- sprintf(tr_("# %s method for class '%s'"), type, class)
-  }
-
-  paste0(method, "\n", fun)
-}
-
 # Conditionals and Sexprs ----------------------------------------------------
 
 #' @export

R/theme.R

@@ -36,7 +36,9 @@ bs_theme <- function(pkg = ".") {
 
   bs_theme_args <- pkg$meta$template$bslib %||% list()
   bs_theme_args[["version"]] <- pkg$bs_version
+  # In bslib >= 0.5.1, bs_theme() takes bootstrap preset theme via `preset`
   bs_theme_args[["preset"]] <- get_bslib_theme(pkg)
+  bs_theme_args[["bootswatch"]] <- NULL
 
   bs_theme <- exec(bslib::bs_theme, !!!bs_theme_args)
 
@@ -91,31 +93,35 @@ highlight_styles <- function() {
 }
 
 get_bslib_theme <- function(pkg) {
-  preset <- pkg$meta[["template"]]$bslib$preset
+  themes <- list(
+    "template.bslib.preset" = pkg$meta[["template"]]$bslib$preset,
+    "template.bslib.bootswatch" = pkg$meta[["template"]]$bslib$bootswatch,
+    "template.bootswatch" = pkg$meta[["template"]]$bootswatch,
+    # Historically (< 0.2.0), bootswatch wasn't a top-level template field
+    "template.params.bootswatch" = pkg$meta[["template"]]$params$bootswatch
+  )
 
-  if (!is.null(preset)) {
-    check_bslib_theme(preset, pkg, c("template", "bslib", "preset"))
-    return(preset)
-  }
+  is_present <- !purrr::map_lgl(themes, is.null)
+  n_present <- sum(is_present)
+  n_unique <- length(unique(themes[is_present]))
 
-  bootswatch <-
-    pkg$meta[["template"]]$bootswatch %||%
-    # Historically (< 0.2.0), bootswatch wasn't a top-level template field
-    pkg$meta[["template"]]$params$bootswatch
+  if (n_present == 0) {
+    return("default")
+  }
 
-  if (!is.null(bootswatch)) {
-    check_bslib_theme(bootswatch, pkg, c("template", "bootswatch"))
-    return(bootswatch)
+  if (n_present > 1 && n_unique > 1) {
+    cli::cli_warn(c(
+      "Multiple Bootstrap preset themes were set. Using {.val {themes[is_present][[1]]}} from {.field {names(themes)[is_present][1]}}.",
+      x = "Found {.and {.field {names(themes)[is_present]}}}.",
+      i = "Remove extraneous theme declarations to avoid this warning."
+    ))
   }
 
-  "default"
+  field <- names(themes)[which(is_present)[1]]
+  check_bslib_theme(themes[[field]], pkg, strsplit(field, ".")[[1]])
 }
 
 check_bslib_theme <- function(theme, pkg, field = c("template", "bootswatch"), bs_version = pkg$bs_version) {
-  if (theme %in% c("_default", "default")) {
-    return("default")
-  }
-
   bslib_themes <- c(
     bslib::bootswatch_themes(bs_version),
     bslib::builtin_themes(bs_version),

R/usage.R

@@ -1,3 +1,35 @@
+# Reference page ---------------------------------------------------------------
+
+#' @export
+as_data.tag_usage <- function(x, ...) {
+  text <- paste(flatten_text(x, ..., escape = FALSE), collapse = "\n")
+  text <- str_trim(text)
+
+  highlight_text(text)
+}
+
+#' @export
+as_html.tag_method <- function(x, ...) method_usage(x, "S3")
+#' @export
+as_html.tag_S3method <- function(x, ...) method_usage(x, "S3")
+#' @export
+as_html.tag_S4method <- function(x, ...) method_usage(x, "S4")
+
+method_usage <- function(x, type) {
+  fun <- as_html(x[[1]])
+  class <- as_html(x[[2]])
+
+  if (x[[2]] == "default") {
+    method <- sprintf(tr_("# Default %s method"), type)
+  } else {
+    method <- sprintf(tr_("# %s method for class '%s'"), type, class)
+  }
+
+  paste0(method, "\n", fun)
+}
+
+# Reference index --------------------------------------------------------------
+
 topic_funs <- function(rd) {
   funs <- parse_usage(rd)
 
@@ -24,17 +56,12 @@ parse_usage <- function(x) {
   }
 
   exprs <- tryCatch(
-    {
-      parse_exprs(r)
-    },
+    parse_exprs(r),
     error = function(e) {
-      cli::cli_warn(
-        "Failed to parse usage: {.code {r}}"
-      )
+      cli::cli_warn("Failed to parse usage: {.code {r}}")
       list()
     }
-  )
-
+  )  
   purrr::map(exprs, usage_type)
 }
 
@@ -62,7 +89,6 @@ short_name <- function(name, type, signature) {
 }
 
 # Given single expression generated from usage_code, extract
-
 usage_type <- function(x) {
   if (is_symbol(x)) {
     list(type = "data", name = as.character(x))

inst/BS5/assets/pkgdown.scss

@@ -207,10 +207,6 @@ body > .container .row {
 
 /* General typography ======================================================= */
 
-::selection {
-  background-color: mix($primary, $body-bg, 20%);
-}
-
 // Ensure in-page images don't run outside their container
 main img {
   max-width: 100%;

tests/testthat/_snaps/package.md

@@ -1,3 +1,16 @@
+# is_pkgdown checks its inputs
+
+    Code
+      as_pkgdown(1)
+    Condition
+      Error in `as_pkgdown()`:
+      ! `pkg` must be a single string, not the number 1.
+    Code
+      as_pkgdown(override = 1)
+    Condition
+      Error in `as_pkgdown()`:
+      ! `override` must be a list, not the number 1.
+
 # check_bootstrap_version() gives informative error otherwise
 
     Code

tests/testthat/_snaps/preview.md

@@ -0,0 +1,13 @@
+# checks its inputs
+
+    Code
+      preview_site(pkg, path = 1)
+    Condition
+      Error in `preview_site()`:
+      ! `path` must be a single string, not the number 1.
+    Code
+      preview_site(pkg, preview = 1)
+    Condition
+      Error in `preview_site()`:
+      ! `preview` must be `TRUE`, `FALSE`, or `NA`, not the number 1.
+

tests/testthat/_snaps/templates.md

@@ -16,3 +16,9 @@
       Error in `as_pkgdown()`:
       ! Both template.bootstrap and template.bslib.version are set.
 
+# Warns when Bootstrap theme is specified in multiple locations
+
+    Multiple Bootstrap preset themes were set. Using "flatly" from template.bslib.preset.
+    x Found template.bslib.preset, template.bslib.bootswatch, template.bootswatch, and template.params.bootswatch.
+    i Remove extraneous theme declarations to avoid this warning.
+

tests/testthat/_snaps/usage.md

@@ -0,0 +1,15 @@
+# usage escapes special characters
+
+    Code
+      # Parseable
+      cat(strip_html_tags(usage2html("# <>\nx")))
+    Output
+      # &lt;&gt;
+      x
+    Code
+      # Unparseable
+      cat(strip_html_tags(usage2html("# <>\n<")))
+    Output
+      # &lt;&gt;
+      &lt;
+

tests/testthat/assets/articles/vignettes/needs-escape.Rmd

@@ -0,0 +1,4 @@
+---
+title: "a <-> b"
+---
+

tests/testthat/assets/reference/DESCRIPTION

@@ -3,4 +3,4 @@ Version: 1.0.0
 Title: A test package
 Description: A test package
 Authors@R: person("Hadley Wickham")
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

tests/testthat/assets/reference/R/funs.R

@@ -27,3 +27,8 @@ NULL
 #' @examples
 #' testpackage:::f()
 f <- function() {runif(5L)}
+
+
+#' g <-> h
+#' @keywords internal
+g <- function() 1