Add anchors to arguments (r-lib#2499)

Fixes r-lib#2228

NEWS.md

@@ -1,5 +1,7 @@
 # pkgdown (development version)
 
+* Anchors are displayed when they're the target of a link.
+* `build_reference()` adds anchors to arguments making it possible to link directly to an argument, if desired. A subtle visual treatment makes it easy to see which argument is targeted (#2228).
 * `build_redirects()` is now exported to make it easier to document (#2500).
 * `build_reference()` now automatically renders any tables created by gt (#2326).
 * `build_articles()` now drops a section called "internal". This allows you to have articles that either aren't indexed at all or are included manually elsewhere in the navbar (#2205).

R/rd-data.R

@@ -65,7 +65,7 @@ as_data.tag_section <- function(x, ...) {
 as_data.tag_arguments <- function(x, ...) {
   list(
     title = tr_("Arguments"),
-    contents = describe_contents(x, ...)
+    contents = describe_contents(x, ..., id_prefix = "arg-")
   )
 }
 
@@ -77,7 +77,7 @@ as_data.tag_value <- function(x, ...) {
   )
 }
 
-describe_contents <- function(x, ...) {
+describe_contents <- function(x, ..., id_prefix = NULL) {
   # Drop pure whitespace nodes between items
   is_ws <- purrr::map_lgl(x, is_whitespace)
 
@@ -90,7 +90,7 @@ describe_contents <- function(x, ...) {
     if (length(x) == 0) {
       NULL
     } else if (any(purrr::map_lgl(x, inherits, "tag_item"))) {
-      paste0("<dl>\n", parse_descriptions(x, ...), "</dl>")
+      paste0("<dl>\n", parse_descriptions(x, ..., id_prefix = id_prefix), "</dl>")
     } else {
       flatten_para(x, ...)
     }

R/rd-html.R

@@ -366,16 +366,27 @@ parse_items <- function(rd, ...) {
     paste(collapse = "")
 }
 
-parse_descriptions <- function(rd, ...) {
+parse_descriptions <- function(rd, ..., id_prefix = NULL) {
   if (length(rd) == 0) {
     return(character())
   }
 
   parse_item <- function(x) {
     if (inherits(x, "tag_item")) {
+      term <- flatten_text(x[[1]], ...)
+      def <- flatten_para(x[[2]], ...)
+
+      if (!is.null(id_prefix)) {
+        id <- paste0(id_prefix, make_slug(term))
+        id_attr <- paste0(" id='", id, "'")
+        anchor <- anchor_html(id)
+      } else {
+        id_attr <- ""
+        anchor <- ""
+      }
       paste0(
-        "<dt>", flatten_text(x[[1]], ...), "</dt>\n",
-        "<dd>", flatten_para(x[[2]], ...), "</dd>\n"
+        "<dt", id_attr, ">", term, anchor, "</dt>\n",
+        "<dd>", def , "</dd>\n"
       )
     } else {
       flatten_text(x, ...)

R/tweak-tags.R

@@ -22,9 +22,7 @@ tweak_anchors <- function(html) {
   xml2::xml_attr(headings, "id") <- new_id
 
   # Insert anchors
-  anchor <- paste0(
-    "<a class='anchor' aria-label='anchor' href='#", new_id, "'></a>"
-  )
+  anchor <- anchor_html(new_id)
   for (i in seq_along(headings)) {
     heading <- headings[[i]]
     if (length(xml2::xml_contents(heading)) == 0) {
@@ -37,6 +35,10 @@ tweak_anchors <- function(html) {
   invisible()
 }
 
+anchor_html <- function(id) {
+  paste0("<a class='anchor' aria-label='anchor' href='#", id, "'></a>")
+}
+
 tweak_link_md <- function(html) {
   links <- xml2::xml_find_all(html, ".//a")
   if (length(links) == 0)

inst/BS5/assets/pkgdown.scss

@@ -236,8 +236,9 @@ body {
 
 // spacing tweaks
 dd {
-  margin-left: 1.5rem;
+  padding-left: 1.5rem;
 }
+
 summary {
   margin-bottom: 0.5rem;
 }
@@ -252,7 +253,9 @@ details {
 // Section anchors
 a.anchor {
   display: none;
-  margin-left: 5px;
+  // style like a footnote
+  margin-left: 2px;
+  vertical-align: top;
   width: Min(0.9em, 20px);
   height: Min(0.9em, 20px);
 
@@ -261,8 +264,20 @@ a.anchor {
   background-size: Min(0.9em, 20px) Min(0.9em, 20px);
   background-position: center center;
 }
-h2, h3, h4, h5, h6 {
-  &:hover .anchor {display: inline-block;}
+h2, h3, h4, h5, h6, dt {
+  &:hover .anchor, &:target .anchor {display: inline-block;}
+}
+
+// Give targetted arguments some visual distinction
+dt:target, dt:target + dd {
+  border-left: 0.25rem solid $primary;
+  margin-left: -0.75rem;
+}
+dt:target {
+  padding-left: 0.5rem;
+}
+dt:target + dd {
+  padding-left: 2rem;
 }
 
 // orcid badge

tests/testthat/_snaps/rd-html.md

@@ -86,6 +86,18 @@
     <p>Paragraph 2</p></dd>
 
 
+    </dl>
+
+# can add ids to descriptions
+
+    <dl>
+    <dt id='fooabc'>abc<a class='anchor' aria-label='anchor' href='#fooabc'></a></dt>
+    <dd><p>Contents 1</p></dd>
+
+    <dt id='fooxyz'>xyz<a class='anchor' aria-label='anchor' href='#fooxyz'></a></dt>
+    <dd><p>Contents 2</p></dd>
+
+
     </dl>
 
 # nested item with whitespace parsed correctly

tests/testthat/assets/reference/R/funs.R

@@ -1,7 +1,10 @@
 #' A
 #' @export
 #' @keywords foo
-a <- function() {}
+#' @param a a letter
+#' @param b a a number
+#' @param c a logical
+a <- function(a, b, c) {}
 
 #' B
 #' @export

tests/testthat/test-build-reference.R

@@ -104,6 +104,15 @@ test_that("examples are reproducible by default, i.e. 'seed' is respected", {
   expect_snapshot(cat(examples))
 })
 
+test_that("arguments get individual ids", {
+  pkg <- local_pkgdown_site(test_path("assets/reference"))
+  suppressMessages(build_reference(pkg, topics = "a"))
+
+  html <- xml2::read_html(file.path(pkg$dst_path, "reference", "a.html"))
+  expect_equal(xpath_attr(html, "//dt", "id"), c("arg-a", "arg-b", "arg-c"))
+
+})
+
 test_that("title and page title escapes html", {
   pkg <- local_pkgdown_site(test_path("assets/reference"))
   suppressMessages(build_reference(pkg, topics = "g"))

tests/testthat/test-rd-html.R

@@ -355,6 +355,14 @@ test_that("\\describe items can contain multiple paragraphs", {
   expect_snapshot_output(cat(out, sep = "\n"))
 })
 
+test_that("can add ids to descriptions", {
+  out <- rd2html("\\describe{
+    \\item{abc}{Contents 1}
+    \\item{xyz}{Contents 2}
+  }", id_prefix = "foo")
+  expect_snapshot_output(cat(out, sep = "\n"))
+})
+
 test_that("\\describe items can contain multiple paragraphs", {
   out <- rd2html("\\describe{
     \\item{Label}{