diff --git a/NEWS.md b/NEWS.md
index 7553c55dd..91de111ea 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,7 @@
# pkgdown (development version)
+* pkgdown, for Bootstrap 4, supports tabsets in articles [as in R Markdown](https://bookdown.org/yihui/rmarkdown-cookbook/html-tabs.html) including [fading effect](https://bookdown.org/yihui/rmarkdown/html-document.html#tabbed-sections) (@JamesHWade, #1667).
+
* New template option `trailingslash_redirect` that allows adding a script to redirect `your-package-url.com` to `your-package-url.com/`. (#1439, @cderv, @apreshill)
* `build_reference()` now runs examples with two more local options `rlang_interactive = FALSE` (therefore ensuring non-interactive behavior even in interactive sessions -- see `rlang::is_interactive()`) and `cli.dynamic = FALSE`, `withr::local_envvar(RSTUDIO = NA)` and `withr::local_collate("C")`(#1693).
diff --git a/R/html-tweak.R b/R/html-tweak.R
index f1af66335..5692a08e8 100644
--- a/R/html-tweak.R
+++ b/R/html-tweak.R
@@ -103,6 +103,11 @@ tweak_class_prepend <- function(x, class) {
invisible()
}
+has_class <- function(html, class) {
+ classes <- strsplit(xml2::xml_attr(html, "class"), " ")
+ purrr::map_lgl(classes, ~ class %in% .x)
+}
+
# from https://github.com/rstudio/bookdown/blob/ed31991df3bb826b453f9f50fb43c66508822a2d/R/bs4_book.R#L307
tweak_footnotes <- function(html) {
container <- xml2::xml_find_all(html, ".//div[@class='footnotes']")
@@ -129,6 +134,133 @@ tweak_footnotes <- function(html) {
xml2::xml_remove(container)
}
+# Tabsets tweaking: find Markdown recommended in https://bookdown.org/yihui/rmarkdown-cookbook/html-tabs.html
+# and https://bookdown.org/yihui/rmarkdown/html-document.html#tabbed-sections
+# i.e. "## Heading {.tabset}" or "## Heading {.tabset .tabset-pills}"
+# no matter the heading level -- the headings one level down are the tabs
+# and transform to tabsets HTML a la Bootstrap
+
+tweak_tabsets <- function(html) {
+ tabsets <- xml2::xml_find_all(html, ".//div[contains(@class, 'tabset')]")
+ purrr::walk(tabsets, tweak_tabset)
+ invisible(html)
+}
+
+tweak_tabset <- function(html) {
+ id <- xml2::xml_attr(html, "id")
+
+ # Users can choose pills or tabs
+ nav_class <- if (has_class(html, "tabset-pills")) {
+ "nav-pills"
+ } else {
+ "nav-tabs"
+ }
+ # Users can choose to make content fade
+ fade <- has_class(html, "tabset-fade")
+
+ # Get tabs and remove them from original HTML
+ tabs <- xml2::xml_find_all(html, "div")
+ xml2::xml_remove(tabs)
+
+ # Add empty ul for nav and div for content
+ xml2::xml_add_child(
+ html,
+ "ul",
+ class = sprintf("nav %s nav-row", nav_class),
+ id = id,
+ role = "tablist"
+ )
+ xml2::xml_add_child(html, "div", class="tab-content")
+
+ # Fill the ul for nav and div for content
+ purrr::walk(tabs, tablist_item, html = html, parent_id = id)
+ purrr::walk(tabs, tablist_content, html = html, parent_id = id, fade = fade)
+
+ # activate first tab unless another one is already activated
+ # (by the attribute {.active} in the source Rmd)
+ nav_links <- xml2::xml_find_all(html, sprintf("//ul[@id='%s']/li/a", id))
+
+ if (!any(has_class(nav_links, "active"))) {
+ tweak_class_prepend(nav_links[1], "active")
+ }
+
+ content_div <- xml2::xml_find_first(html, sprintf("//div[@id='%s']/div", id))
+ if (!any(has_class(xml2::xml_children(content_div), "active"))) {
+ tweak_class_prepend(xml2::xml_child(content_div), "active")
+ if (fade) {
+ tweak_class_prepend(xml2::xml_child(content_div), "show")
+ }
+ }
+}
+
+# Add an item (tab) to the tablist
+tablist_item <- function(tab, html, parent_id) {
+ id <- xml2::xml_attr(tab, "id")
+ text <- xml_text1(xml2::xml_child(tab))
+ ul_nav <- xml2::xml_find_first(html, sprintf("//ul[@id='%s']", parent_id))
+
+ # Activate (if there was "{.active}" in the source Rmd)
+ active <- has_class(tab, "active")
+ class <- if (active) {
+ "nav-link active"
+ } else {
+ "nav-link"
+ }
+
+ xml2::xml_add_child(
+ ul_nav,
+ "a",
+ text,
+ `data-toggle` = "tab",
+ href = paste0("#", id),
+ role = "tab",
+ `aria-controls` = id,
+ `aria-selected` = tolower(as.character(active)),
+ class = class
+ )
+
+ # tab a's need to be wrapped in li's
+ xml2::xml_add_parent(
+ xml2::xml_find_first(html, sprintf("//a[@href='%s']", paste0("#", id))),
+ "li",
+ role = "presentation",
+ class = "nav-item"
+ )
+}
+
+# Add content of a tab to a tabset
+tablist_content <- function(tab, html, parent_id, fade) {
+ active <- has_class(tab, "active")
+
+ # remove first child, that is the header
+ xml2::xml_remove(xml2::xml_child(tab))
+
+ xml2::xml_attr(tab, "class") <- "tab-pane"
+ if (fade) {
+ tweak_class_prepend(tab, "fade")
+ }
+
+ # Activate (if there was "{.active}" in the source Rmd)
+ if (active) {
+ tweak_class_prepend(tab, "active")
+ if (fade) {
+ tweak_class_prepend(tab, "show")
+ }
+ }
+
+ xml2::xml_attr(tab, "role") <- "tabpanel"
+ xml2::xml_attr(tab, " aria-labelledby") <- xml2::xml_attr(tab, "id")
+
+ content_div <- xml2::xml_find_first(
+ html,
+ sprintf("//div[@id='%s']/div", parent_id)
+ )
+
+ xml2::xml_add_child(content_div, tab)
+}
+
+
+
# File level tweaks --------------------------------------------
tweak_rmarkdown_html <- function(html, input_path, pkg = pkg) {
@@ -137,13 +269,20 @@ tweak_rmarkdown_html <- function(html, input_path, pkg = pkg) {
tweak_anchors(html, only_contents = FALSE)
tweak_md_links(html)
tweak_all_links(html, pkg = pkg)
- if (pkg$bs_version > 3) tweak_footnotes(html)
+
+ if (pkg$bs_version > 3) {
+ # Tweak footnotes
+ tweak_footnotes(html)
+
+ # Tweak tabsets
+ tweak_tabsets(html)
+ }
# Tweak classes of navbar
toc <- xml2::xml_find_all(html, ".//div[@id='tocnav']//ul")
xml2::xml_attr(toc, "class") <- "nav nav-pills nav-stacked"
- # Mame sure all images use relative paths
+ # Make sure all images use relative paths
img <- xml2::xml_find_all(html, "//img")
src <- xml2::xml_attr(img, "src")
abs_src <- is_absolute_path(src)
diff --git a/inst/assets/BS4/pkgdown.css b/inst/assets/BS4/pkgdown.css
index 5699583ac..9e125fecf 100644
--- a/inst/assets/BS4/pkgdown.css
+++ b/inst/assets/BS4/pkgdown.css
@@ -465,3 +465,34 @@ summary {
details p {
margin-top: -.5rem;
}
+
+/* tabsets */
+.nav-row {
+ flex-direction: row;
+}
+
+.tab-content {
+ padding: 1rem;
+}
+
+.tabset-pills .tab-content {
+ border: solid 1px #e5e5e5;
+}
+
+/* https://observablehq.com/@rkaravia/css-trick-tabs-with-consistent-height */
+/* Make tab height consistent */
+
+.tab-content {
+ display: flex;
+}
+
+.tab-content > .tab-pane {
+ display: block; /* undo "display: none;" */
+ visibility: hidden;
+ margin-right: -100%;
+ width: 100%;
+}
+
+.tab-content > .active {
+ visibility: visible;
+}
diff --git a/tests/testthat/_snaps/html-tweak.md b/tests/testthat/_snaps/html-tweak.md
index 1df5c2962..8fa2016a0 100644
--- a/tests/testthat/_snaps/html-tweak.md
+++ b/tests/testthat/_snaps/html-tweak.md
@@ -100,3 +100,81 @@
[1] \n
+
+
+ Results in tabset
+
+
+
+
+
+
+# tweak_tabsets() with tab pills and second tab active
+
+
+
+
+ Results in tabset
+
+
+
+
+
+
+# tweak_tabsets() with tab pills, fade and second tab active
+
+
+
+
+ Results in tabset
+
+
+
+
+
+
diff --git a/tests/testthat/test-html-tweak.R b/tests/testthat/test-html-tweak.R
index 21cdfa072..4ebc23922 100644
--- a/tests/testthat/test-html-tweak.R
+++ b/tests/testthat/test-html-tweak.R
@@ -354,3 +354,69 @@ test_that("activate_navbar()", {
xml2::xml_find_first(navbar, ".//li[contains(@class, 'active')]")
)
})
+
+# tabsets -------------------------------------------------------------
+
+test_that("tweak_tabsets() default", {
+ html <- '
+
+Results in tabset
+
+
+Tab 1
+
blablablabla
+
+
+
+
'
+ new_html <- tweak_tabsets(xml2::read_html(html))
+ expect_snapshot_output(cat(as.character(new_html)))
+})
+
+test_that("tweak_tabsets() with tab pills and second tab active", {
+ html <- '
+
+Results in tabset
+
+
+Tab 1
+
blablablabla
+
+
+
+
'
+ new_html <- tweak_tabsets(xml2::read_html(html))
+ expect_snapshot_output(cat(as.character(new_html)))
+})
+
+
+test_that("tweak_tabsets() with tab pills, fade and second tab active", {
+ html <- '
+
+Results in tabset
+
+
+Tab 1
+
blablablabla
+
+
+
+
'
+ new_html <- tweak_tabsets(xml2::read_html(html))
+ expect_snapshot_output(cat(as.character(new_html)))
+})
diff --git a/vignettes/test/rendering.Rmd b/vignettes/test/rendering.Rmd
index 77eff9eb1..3e05e1667 100644
--- a/vignettes/test/rendering.Rmd
+++ b/vignettes/test/rendering.Rmd
@@ -185,3 +185,54 @@ Blablablablablabla.
# This section is unnumbered {-}
There should however be no bug here!
+
+## Results in tabset {.tabset .tabset-pills}
+
+### Tab 1
+
+blablablabla
+
+```r
+1 + 1
+```
+
+### Tab 2
+
+blop
+
+
+## Results in tabset, no pills {.tabset}
+
+### A thing
+
+something nice
+
+```{r}
+plot(1:42)
+```
+
+#### cool
+
+yay
+
+### Tab 2 {.active}
+
+hello
+
+## Results in tabset, fading {.tabset .tabset-fade}
+
+### Something
+
+ok
+
+```{r}
+plot(1)
+```
+
+#### cool
+
+yay
+
+### Nice {.active}
+
+bonjour