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

+ + + +
+
+ +

blablablabla

+
+    1 + 1
+
+
+ +

blop

+
+
+
+ +# tweak_tabsets() with tab pills and second tab active + + +
+

+ Results in tabset

+ + + +
+
+ +

blablablabla

+
+    1 + 1
+
+
+ +

blop

+
+
+
+ +# tweak_tabsets() with tab pills, fade and second tab active + + +
+

+ Results in tabset

+ + + +
+
+ +

blablablabla

+
+    1 + 1
+
+
+ +

blop

+
+
+
+ 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

+
+1 + 1
+
+
+

+Tab 2

+

blop

+
+
' + 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

+
+1 + 1
+
+
+

+Tab 2

+

blop

+
+
' + 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

+
+1 + 1
+
+
+

+Tab 2

+

blop

+
+
' + 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