tweak_anchors <- function(html) { headings <- xml2::xml_find_all(html, ".//h1|.//h2|.//h3|.//h4|.//h5|.//h6") # Find all headings that are contained in a div with an id and # have class 'section' is_ok <- xml2::xml_find_lgl(headings, "boolean(parent::div[contains(@class, 'section') and @id])" ) headings <- headings[is_ok] if (length(headings) == 0) { return(invisible()) } id <- xml2::xml_find_chr(headings, "string(parent::div/@id)") # Update ids: dot in the anchor breaks scrollspy and rd translation # doesn't have enough information to generate unique ids new_id <- make.unique(gsub(".", "-", id, fixed = TRUE), "-") # Move ids to headings so that the js TOC doesn't add create new ids divs <- xml2::xml_parent(headings) xml2::xml_attr(divs, "id") <- NULL xml2::xml_attr(headings, "id") <- new_id # Insert anchors anchor <- paste0( "<a class='anchor' aria-label='anchor' href='#", new_id, "'></a>" ) for (i in seq_along(headings)) { heading <- headings[[i]] if (length(xml2::xml_contents(heading)) == 0) { # skip empty headings next } # Insert anchor in first element of header xml2::xml_add_child(heading, xml2::read_xml(anchor[[i]])) } invisible() } tweak_link_md <- function(html) { links <- xml2::xml_find_all(html, ".//a") if (length(links) == 0) return() hrefs <- xml2::xml_attr(links, "href") needs_tweak <- grepl("\\.md$", hrefs) & xml2::url_parse(hrefs)$scheme == "" fix_links <- function(x) { x <- gsub("\\.md$", ".html", x) x <- gsub("\\.github/", "", x) x } if (any(needs_tweak)) { purrr::walk2( links[needs_tweak], fix_links(hrefs[needs_tweak]), xml2::xml_set_attr, attr = "href" ) } invisible() } tweak_link_external <- function(html, pkg = list()) { links <- xml2::xml_find_all(html, ".//a") if (length(links) == 0) return() links <- links[!has_class(links, "external-link")] hrefs <- xml2::xml_attr(links, "href") links <- links[!is_internal_link(hrefs, pkg = pkg)] # Users might have added absolute URLs to e.g. the Code of Conduct tweak_class_prepend(links, "external-link") invisible() } # Fix relative image links tweak_img_src <- function(html) { imgs <- xml2::xml_find_all(html, ".//img[not(starts-with(@src, 'http'))]") urls <- xml2::xml_attr(imgs, "src") new_urls <- gsub("(^|/)vignettes/", "\\1articles/", urls, perl = TRUE) new_urls <- gsub("(^|/)man/figures/", "\\1reference/figures/", new_urls, perl = TRUE) purrr::map2(imgs, new_urls, ~ xml2::xml_set_attr(.x, "src", .y)) invisible() } tweak_link_absolute <- function(html, pkg = list()) { # If there's no URL links can't be made absolute if (is.null(pkg$meta$url)) { return() } url <- paste0(pkg$meta$url, "/") # <a> + <link> use href href <- xml2::xml_find_all(html, ".//a | .//link") xml2::xml_attr(href, "href") <- xml2::url_absolute(xml2::xml_attr(href, "href"), url) # <img> + <script> uses src src <- xml2::xml_find_all(html, ".//script | .//img") xml2::xml_attr(src, "src") <- xml2::url_absolute(xml2::xml_attr(src, "src"), url) invisible() } tweak_link_R6 <- function(html, cur_package) { r6_span <- xml2::xml_find_all(html, ".//span[@class=\"pkg-link\"]") if (length(r6_span) == 0) { return() } pkg <- xml2::xml_attr(r6_span, "data-pkg") topic <- xml2::xml_attr(r6_span, "data-topic") id <- xml2::xml_attr(r6_span, "data-id") url <- paste0(topic, ".html") external <- pkg != cur_package if (any(external)) { url[external] <- purrr::map2_chr(topic[external], pkg[external], downlit::href_topic) } url <- paste0(url, ifelse(is.na(id), "", "#method-"), id) r6_a <- xml2::xml_find_first(r6_span, "./a") xml2::xml_attr(r6_a, "href") <- url invisible() } tweak_tables <- function(html) { # Ensure all tables have class="table" apart from arguments table <- xml2::xml_find_all(html, ".//table") table <- table[!has_class(table, "ref-arguments")] tweak_class_prepend(table, "table") invisible() } # from https://github.com/rstudio/bookdown/blob/ed31991df3bb826b453f9f50fb43c66508822a2d/R/bs4_book.R#L307 tweak_footnotes <- function(html) { container <- xml2::xml_find_all(html, ".//div[contains(@class, 'footnotes')]") if (length(container) != 1) { return() } # Find id and contents footnotes <- xml2::xml_find_all(container, ".//li") id <- xml2::xml_attr(footnotes, "id") xml2::xml_remove(xml2::xml_find_all(footnotes, "//a[@class='footnote-back']")) contents <- vapply(footnotes, FUN.VALUE = character(1), function(x) { paste(as.character(xml2::xml_children(x), options = character()), collapse = "\n") }) # Add popover attributes to links for (i in seq_along(id)) { links <- xml2::xml_find_all(html, paste0(".//a[@href='#", id[[i]], "']")) xml2::xml_attr(links, "href") <- NULL xml2::xml_attr(links, "id") <- NULL xml2::xml_attr(links, "tabindex") <- "0" xml2::xml_attr(links, "data-bs-toggle") <- "popover" xml2::xml_attr(links, "data-bs-content") <- contents[[i]] } # Delete container xml2::xml_remove(container) } tweak_strip <- function(html, in_dev = FALSE) { to_remove <- if (in_dev) "pkgdown-release" else "pkgdown-devel" xpath <- paste0( ".//*[contains(@class, '", to_remove, "')]|", ".//*[contains(@class, 'pkgdown-hide')]" ) nodes <- xml2::xml_find_all(html, xpath) xml2::xml_remove(nodes) }