more sidebar customization

NEWS.md

@@ -1,5 +1,12 @@
 # pkgdown (development version)
 
+* Make sidebar specification more flexible: users can now
+    * change the order of sidebar elements
+    * add custom sidebar sections (title, text that has to be HTML)
+    * completely suppress the navbar (even "Dev status")
+    * provide their own HTML for the navbar. (#1443, #1488)
+
+
 * Protect the rules drawn by the CLI (as for example, in `build_site()`) against
   very narrow terminal windows with small `getOption('width')`s 
   (@maxheld83, #1435).

R/build-home-index.R

@@ -20,7 +20,13 @@ build_home_index <- function(pkg = ".", quiet = TRUE) {
   render_page(pkg, "home", data, "index.html", quiet = quiet)
 
   strip_header <- isTRUE(pkg$meta$home$strip_header)
-  update_html(dst_path, tweak_homepage_html, strip_header = strip_header)
+
+  update_html(
+    dst_path,
+    tweak_homepage_html,
+    strip_header = strip_header,
+    sidebar = !isFALSE(pkg$meta$home$sidebar)
+  )
 
   invisible()
 }
@@ -37,19 +43,112 @@ data_home <- function(pkg = ".") {
   ))
 }
 
+
 data_home_sidebar <- function(pkg = ".") {
+
   pkg <- as_pkgdown(pkg)
-  if (!is.null(pkg$meta$home$sidebar))
+  if (isFALSE(pkg$meta$home$sidebar))
     return(pkg$meta$home$sidebar)
 
-  paste0(
-    data_home_sidebar_links(pkg),
-    data_home_sidebar_license(pkg),
-    data_home_sidebar_community(pkg),
-    data_home_sidebar_citation(pkg),
-    data_home_sidebar_authors(pkg),
-    collapse = "\n"
+  html_path <- file.path(pkg$src_path, pkg$meta$home$sidebar$html)
+
+  if (length(html_path)) {
+    if (!file.exists(html_path)) {
+      abort(
+        sprintf(
+          "Can't find file '%s' specified by %s.",
+          pkg$meta$home$sidebar$html,
+          pkgdown_field(pkg = pkg, "home", "sidebar", "html")
+        )
+      )
+    }
+    return(paste0(read_lines(html_path), collapse = "\n"))
+  }
+
+  sidebar_structure <- pkg$meta$home$sidebar$structure %||%
+    default_sidebar_structure()
+
+  # compute all default sections
+  sidebar_components <- list(
+    links = data_home_sidebar_links(pkg),
+    license = data_home_sidebar_license(pkg),
+    community = data_home_sidebar_community(pkg),
+    citation = data_home_sidebar_citation(pkg),
+    authors = data_home_sidebar_authors(pkg),
+    dev = sidebar_section("Dev Status", "placeholder")
   )
+
+  if (is.null(pkg$meta$home$sidebar$structure)) {
+    sidebar_html <- paste0(
+      purrr::compact(sidebar_components),
+      collapse = "\n"
+    )
+    return(sidebar_html)
+  }
+
+  # compute any custom component
+  components <- pkg$meta$home$sidebar$components
+
+  sidebar_components <- utils::modifyList(
+    sidebar_components,
+    purrr::map2(
+      components,
+      names(components),
+      data_home_component,
+      pkg = pkg
+      ) %>%
+      set_names(names(components))
+  )
+
+  missing <- setdiff(sidebar_structure, names(sidebar_components))
+
+  if (length(missing) > 0) {
+    missing_components <- lapply(
+      missing, append,
+      c("home", "sidebar", "components"),
+      after = 0
+    )
+    missing_fields <- pkgdown_fields(pkg = pkg, fields = missing_components)
+
+    abort(
+      sprintf(
+        "Can't find component%s %s.",
+        if (length(missing) > 1) "s" else "",
+        paste0(
+          missing_fields, collapse = " nor "
+        )
+      )
+    )
+  }
+
+  sidebar_final_components <- purrr::compact(
+    sidebar_components[sidebar_structure]
+    )
+
+  paste0(sidebar_final_components, collapse = "\n")
+
+}
+
+default_sidebar_structure <- function() {
+  c("links", "license", "community", "citation", "authors", "dev")
+}
+
+data_home_component <- function(component, component_name, pkg) {
+
+  if (!all(c("title", "html") %in% names(component))) {
+    abort(
+      sprintf(
+        "Can't find %s for the component %s",
+        paste0(
+          c("title", "html")[!c("title", "html") %in% names(component)],
+          collapse = " nor "
+          ),
+        pkgdown_field(pkg = pkg, "home", "sidebar", "components", component_name)
+        )
+      )
+  }
+
+  sidebar_section(component$title, bullets = component$html)
 }
 
 data_home_sidebar_links <- function(pkg = ".") {

R/build-home.R

@@ -17,7 +17,7 @@
 #' for you because it only touches files in the `doc/` directory.
 #'
 #' @section Sidebar:
-#' The sidebar is automatically populated with:
+#' By default, the sidebar automatically populated with:
 #'
 #' *   Development status badges found in `README.md`/`index.md`. pkgdown
 #'     identifies badges in three ways:
@@ -60,7 +60,8 @@
 #'         )
 #'       )
 #'     ```
-#'
+#'  You can tweak the navbar by using the YAML configuration, see the corresponding
+#'  section.
 #' @section Images and figures:
 #' If you want to include images in your `README.md`, they must be stored
 #' somewhere in the package so that they can be displayed on the CRAN website.
@@ -120,6 +121,38 @@
 #'     href: http://website.com
 #' ```
 #'
+#' You can change the order of sidebar components:
+#' `links`, `license` (with an "s"), `community`, `citation`,
+#' `authors`, `dev` (badges); and you can add custom components.
+#' The example below creates a sidebar whose only components will be the
+#' authors section, a custom section, and a Dev Status section if there are
+#' badges.
+#'
+#' ```
+#' home:
+#'   sidebar:
+#'     structure: [authors, custom, dev]
+#'     components:
+#'       custom:
+#'         title: Funding
+#'         html: We are grateful for funding!
+#' ```
+#'
+#' You can provide a ready-made sidebar HTML:
+#'
+#' ```
+#' home:
+#'   sidebar:
+#'     html: path-to-sidebar.html
+#' ```
+#'
+#' Finally, you can completely remove the sidebar.
+#'
+#' ```
+#' home:
+#'   sidebar: FALSE
+#' ```
+#'
 #' READMEs usually start with an `<h1>` containing the package name. If
 #' that feels duplicative with the package name in the navbar you can
 #' remove it with `strip_header: true`:

R/html-tweak.R

@@ -124,18 +124,9 @@ tweak_rmarkdown_html <- function(html, input_path) {
   invisible()
 }
 
-tweak_homepage_html <- function(html, strip_header = FALSE) {
-  badges <- badges_extract(html)
-  if (length(badges) > 0) {
-    list <- sidebar_section("Dev status", badges)
-    list_div <- paste0("<div>", list, "</div>")
-    list_html <- list_div %>% xml2::read_html() %>% xml2::xml_find_first(".//div")
+tweak_homepage_html <- function(html, strip_header = FALSE, sidebar = TRUE) {
 
-    sidebar <- html %>% xml2::xml_find_first(".//div[@id='pkgdown-sidebar']")
-    list_html %>%
-      xml2::xml_children() %>%
-      purrr::walk(~ xml2::xml_add_child(sidebar, .))
-  }
+  html <- tweak_sidebar_html(html, sidebar = sidebar)
 
   # Always remove dummy page header
   header <- xml2::xml_find_all(html, ".//div[contains(@class, 'page-header')]")
@@ -163,6 +154,28 @@ tweak_homepage_html <- function(html, strip_header = FALSE) {
   invisible()
 }
 
+tweak_sidebar_html <- function(html, sidebar) {
+  if (!sidebar) {
+    return(html)
+  }
+
+  dev_status_html <- html %>% xml2::xml_find_first(".//div[@class='dev-status']")
+  if (!inherits(dev_status_html, "xml_node")) {
+    return(html)
+  }
+
+  badges <- badges_extract(html)
+  if (length(badges) == 0) {
+    xml2::xml_remove(dev_status_html)
+    return(html)
+  }
+
+  list <- sidebar_section("Dev status", badges)
+  list_html <- list %>% xml2::read_html() %>% xml2::xml_find_first(".//div")
+  xml2::xml_replace(dev_status_html, list_html)
+  html
+}
+
 # Mutates `html`, removing the badge container
 badges_extract <- function(html) {
   # First try specially named element;

R/package.r

@@ -74,15 +74,19 @@ read_desc <- function(path = ".") {
 
 # Metadata ----------------------------------------------------------------
 
-read_meta <- function(path) {
-  path <- path_first_existing(
+pkgdown_config_path <- function(path) {
+  path_first_existing(
     path,
     c("_pkgdown.yml",
       "_pkgdown.yaml",
       "pkgdown/_pkgdown.yml",
       "inst/_pkgdown.yml"
     )
   )
+}
+
+read_meta <- function(path) {
+  path <- pkgdown_config_path(path)
 
   if (is.null(path)) {
     yaml <- list()

R/utils.r

@@ -102,6 +102,34 @@ print_yaml <- function(x) {
   structure(x, class = "print_yaml")
 }
 
+pkgdown_field <- function(pkg, ...) {
+
+  field <- paste0(list(...), collapse = ".")
+
+  config_path <- pkgdown_config_path(path = pkg$src_path)
+
+  if (is.null(config_path)) {
+    return(crayon::bold(field))
+  }
+
+  config <- src_path(
+    fs::path_rel(
+      config_path,
+      pkg$src_path
+    )
+  )
+
+  paste0(
+    crayon::bold(field), " in ", config
+  )
+}
+
+pkgdown_fields <- function(pkg, fields) {
+  fields <- purrr::map_chr(fields, paste0, collapse = ".")
+  fields <- toString(crayon::bold(fields))
+  pkgdown_field(pkg, fields)
+}
+
 #' @export
 print.print_yaml <- function(x, ...) {
   cat(yaml::as.yaml(x), "\n", sep = "")
@@ -130,3 +158,7 @@ cran_unquote <- function(string) {
 show_xml <- function(x) {
   cat(as.character(x, options = c("format", "no_declaration")))
 }
+
+isFALSE <- function(x) {
+  is.logical(x) && length(x) == 1L && !is.na(x) && !x
+}