support for tabs in BS4

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) (@JamesHWade, #1667).
+
 * pkgdown (in concert with downlit and roxygen2) is moving towards more consistent HTML structure for syntax highlighting. The goal is to always have a `<div>` with class `sourceCode` (and other classes as needed), which contains one or more `<pre>`s that has class `sourceCode` and the language, and each `<pre>` contains `<code>`. Something like this:
 
     ```html

R/html-tweak.R

@@ -129,6 +129,103 @@ tweak_footnotes <- function(html) {
   xml2::xml_remove(container)
 }
 
+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))
+
+  xml2::xml_add_child(
+    ul_nav,
+    "a",
+    text,
+    `data-toggle` = "tab",
+    #`data-value` = id,
+    href = paste0("#", id),
+    role = "tab"
+  )
+
+  if (grepl("active", xml2::xml_attr(tab, "class"))) {
+    class <- "active"
+  } else {
+    class = ""
+  }
+  # 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",
+    class = class
+  )
+}
+
+# For filling the content div of a tabset
+tablist_content <- function(tab, html, parent_id) {
+  # remove 1st child that is the header
+  xml2::xml_remove(xml2::xml_child(tab))
+
+  if (grepl("active", xml2::xml_attr(tab, "class"))) {
+    xml2::xml_attr(tab, "class") <- sprintf("tab-pane active")
+  } else {
+    xml2::xml_attr(tab, "class") <- sprintf("tab-pane")
+  }
+
+  xml2::xml_attr(tab, "role") <- "tabpanel"
+  #xml2::xml_attr(tab, "data-value") <- 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)
+}
+
+tweak_tabset <- function(html) {
+  id <- xml2::xml_attr(html, "id")
+
+  # Users can choose pills or tabs
+  nav_class <- if (grepl("tabset-pills", xml2::xml_attr(html, "class"))) {
+    "nav-pills"
+  } else {
+    "nav-tabs"
+  }
+
+  # Add empty ul for nav
+  xml2::xml_add_child(html, "ul", class=sprintf("nav %s nav-row", nav_class), id=id)
+  # Add empty div for content
+  xml2::xml_add_child(html, "div", class="tab-content")
+
+  # Identify tabs and get them in an object
+  tabs <- xml2::xml_find_all(html, "div[contains(@id, 'tab')]")
+
+  # Remove tabs from original HTML
+  xml2::xml_remove(tabs)
+
+  # Fill the ul for nav
+  purrr::walk(tabs, tablist_item, html = html, parent_id = id)
+
+  # Fill the div for content
+  purrr::walk(tabs, tablist_content, html = html, parent_id = id)
+
+  # active first
+  nav_url <- xml2::xml_find_first(html, sprintf("//ul[@id='%s']", id))
+  if (!any(grepl("active", xml2::xml_attr(xml2::xml_children(nav_url), "class")))) {
+    tweak_class_prepend(xml2::xml_child(nav_url), "active")
+  }
+
+  content_div <- xml2::xml_find_first(html, sprintf("//div[@id='%s']/div", id))
+  if (!any(grepl("active", xml2::xml_attr(xml2::xml_children(content_div), "class")))) {
+    tweak_class_prepend(xml2::xml_child(content_div), "active")
+  }
+}
+
+tweak_tabsets <- function(html) {
+  tabsets <- xml2::xml_find_all(html, ".//div[contains(@class, 'tabset')]")
+  if (length(tabsets) == 0) {
+    return()
+  }
+  purrr::walk(tabsets, tweak_tabset)
+  return(invisible(html))
+}
+
 # File level tweaks --------------------------------------------
 
 tweak_rmarkdown_html <- function(html, input_path, pkg = pkg) {
@@ -137,8 +234,13 @@ 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)
+
+  # Tweak footnotes
   if (pkg$bs_version > 3) tweak_footnotes(html)
 
+  # Tweak tabsets
+  if (pkg$bs_version > 3) 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"

inst/assets/BS4/pkgdown.css

@@ -465,3 +465,8 @@ summary {
 details p {
   margin-top: -.5rem;
 }
+
+/* tabsets */
+.nav-row {
+  flex-direction: row;
+}

tests/testthat/_snaps/html-tweak/tabsets.html

@@ -0,0 +1,23 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">
+<html><body><div id="results-in-tabset" class="section level2 tabset">
+<h2 class="hasAnchor">
+<a href="#results-in-tabset" class="anchor" aria-hidden="true"></a>Results in tabset</h2>
+
+
+<ul class="nav nav-tabs nav-row" id="results-in-tabset">
+<li class="active "><a data-toggle="tab" href="#tab-1" role="tab">Tab 1</a></li>
+<li class=""><a data-toggle="tab" href="#tab-2" role="tab">Tab 2</a></li>
+</ul>
+<div class="tab-content">
+<div id="tab-1" class="active tab-pane" role="tabpanel">
+
+<p>blablablabla</p>
+<div class="sourceCode" id="cb9"><pre class="downlit sourceCode r">
+<code class="sourceCode R"><span class="fl">1</span> <span class="op">+</span> <span class="fl">1</span></code></pre></div>
+</div>
+<div id="tab-2" class="tab-pane" role="tabpanel">
+
+<p>blop</p>
+</div>
+</div>
+</div></body></html>

tests/testthat/test-html-tweak.R

@@ -354,3 +354,51 @@ test_that("activate_navbar()", {
       xml2::xml_find_first(navbar, ".//li[contains(@class, 'active')]")
   )
 })
+
+# tabsets -------------------------------------------------------------
+
+test_that("tweak_tabsets() default", {
+  html <- '<div id="results-in-tabset" class="section level2 tabset">
+<h2 class="hasAnchor">
+<a href="#results-in-tabset" class="anchor" aria-hidden="true"></a>Results in tabset</h2>
+<div id="tab-1" class="section level3">
+<h3 class="hasAnchor">
+<a href="#tab-1" class="anchor" aria-hidden="true"></a>Tab 1</h3>
+<p>blablablabla</p>
+<div class="sourceCode" id="cb9"><pre class="downlit sourceCode r">
+<code class="sourceCode R"><span class="fl">1</span> <span class="op">+</span> <span class="fl">1</span></code></pre></div>
+</div>
+<div id="tab-2" class="section level3">
+<h3 class="hasAnchor">
+<a href="#tab-2" class="anchor" aria-hidden="true"></a>Tab 2</h3>
+<p>blop</p>
+</div>
+</div>'
+  new_html <- tweak_tabsets(xml2::read_html(html))
+  dir <- withr::local_tempdir()
+  xml2::write_html(new_html, file.path(dir, "tabsets.html"))
+  expect_snapshot_file(file.path(dir, "tabsets.html"))
+})
+
+test_that("tweak_tabsets() with tab pills and second tab active", {
+  html <- '<div id="results-in-tabset" class="section level2 tabset tabset-pills">
+<h2 class="hasAnchor">
+<a href="#results-in-tabset" class="anchor" aria-hidden="true"></a>Results in tabset</h2>
+<div id="tab-1" class="section level3">
+<h3 class="hasAnchor">
+<a href="#tab-1" class="anchor" aria-hidden="true"></a>Tab 1</h3>
+<p>blablablabla</p>
+<div class="sourceCode" id="cb9"><pre class="downlit sourceCode r">
+<code class="sourceCode R"><span class="fl">1</span> <span class="op">+</span> <span class="fl">1</span></code></pre></div>
+</div>
+<div id="tab-2" class="section level3 active">
+<h3 class="hasAnchor">
+<a href="#tab-2" class="anchor" aria-hidden="true"></a>Tab 2</h3>
+<p>blop</p>
+</div>
+</div>'
+  new_html <- tweak_tabsets(xml2::read_html(html))
+  dir <- withr::local_tempdir()
+  xml2::write_html(new_html, file.path(dir, "tabsets-pills-second-active.html"))
+  expect_snapshot_file(file.path(dir, "tabsets-pills-second-activ.html"))
+})

vignettes/test/rendering.Rmd

@@ -185,3 +185,32 @@ 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}
+
+### Tab 1
+
+something nice
+
+```{r}
+plot(1:42)
+```
+
+### Tab 2 {.active}
+
+hello