Use rdtools

DESCRIPTION

@@ -27,10 +27,13 @@ Imports:
     methods,
     pkgbuild,
     processx,
+    rdtools,
     rlang (>= 1.1.1),
     rprojroot,
     utils
-Suggests: 
+Remotes:
+    r-lib/rdtools
+Suggests:
     bitops,
     jsonlite,
     mathjaxr,

NEWS.md

@@ -1,5 +1,8 @@
 # pkgload (development version)
 
+* `dev_example()` now expands the package's custom Rd macros when running examples, matching the behaviour of `dev_help()`.
+* `dev_help()` and friends now use the rdtools package to build and look up the topic index, which is considerably faster. `dev_topic_index()` now returns a named character vector mapping alias to Rd file name (without extension), and an alias documented in multiple Rd files now triggers a warning.
+* `dev_help()` no longer carries a workaround for versions of RStudio that predate `previewRd()`; outside of RStudio, HTML help now opens directly in your browser.
 * `load_code()` can be called directly again (#335).
 
 # pkgload 1.5.3

R/dev-example.R

@@ -19,7 +19,11 @@
 dev_example <- function(topic, quiet = FALSE) {
   topic <- dev_help(topic)
 
-  run_example(topic$path, quiet = quiet)
+  run_example(
+    topic$path,
+    quiet = quiet,
+    macros = rdtools::pkg_macros(topic$pkg)
+  )
 }
 
 #' @rdname dev_example

R/dev-help.R

@@ -1,10 +1,8 @@
 #' In-development help for package loaded with devtools
 #'
 #' `dev_help()` searches for source documentation provided in packages
-#' loaded by devtools. To improve performance, the `.Rd` files are
-#' parsed to create to index once, then cached. Use
-#' `dev_topic_index_reset()` to clear that index. You can manually
-#' retrieve the index for a local package with `dev_topic_index()`.
+#' loaded by devtools. The topic index is maintained by the rdtools
+#' package, which caches it per package.
 #'
 #' @param topic name of help to search for.
 #' @param dev_packages A character vector of package names to search within.
@@ -38,12 +36,6 @@ dev_help <- function(
 
   loc <- dev_topic_find(topic, dev_packages)
 
-  if (!is.null(loc$path) && !fs::file_exists(loc$path)) {
-    # Documentation topic might have moved, so reset topic index and try again
-    dev_topic_index_reset(loc$pkg)
-    loc <- dev_topic_find(topic, dev_packages)
-  }
-
   if (is.null(loc$path) || !fs::file_exists(loc$path)) {
     cli::cli_abort("Can't find development topic {.arg {topic}}.")
   }
@@ -60,29 +52,6 @@ dev_help <- function(
   )
 }
 
-has_rd_macros <- function(dir) {
-  desc <- file.path(dir, "DESCRIPTION")
-  if (!file.exists(desc)) {
-    return(FALSE)
-  }
-
-  tryCatch(
-    expr = {
-      desc <- read.dcf(desc)
-      "RdMacros" %in% colnames(desc)
-    },
-    error = function(...) FALSE
-  )
-}
-
-load_rd_macros <- function(dir) {
-  macros <- tools::loadPkgRdMacros(dir)
-  tools::loadRdMacros(
-    file.path(R.home("share"), "Rd", "macros", "system.Rd"),
-    macros = macros
-  )
-}
-
 #' @export
 print.dev_topic <- function(x, ...) {
   cli::cli_inform(c(
@@ -91,54 +60,31 @@ print.dev_topic <- function(x, ...) {
 
   type <- arg_match0(x$type %||% "text", c("text", "html"))
 
-  # Use rstudio's previewRd() if possible
-  if (type == "html" && rstudioapi_available()) {
-    # If the package has Rd macros, this needs a version of rstudio
-    # that loads them, see rstudio/rstudio#12111
-    version_needed <- if (has_rd_macros(dirname(dirname(x$path)))) {
-      "2022.12.0.256"
-    }
-
-    if (rstudioapi::hasFun("previewRd", version_needed = version_needed)) {
-      return(rstudioapi::callFun("previewRd", x$path))
-    }
+  # Use RStudio's previewRd() if possible
+  rstudio_preview <- type == "html" &&
+    is_installed("rstudioapi") &&
+    rstudioapi::isAvailable() &&
+    rstudioapi::hasFun("previewRd")
+  if (rstudio_preview) {
+    return(rstudioapi::callFun("previewRd", x$path))
   }
 
   # otherwise render and serve
   file <- fs::path_ext_set(fs::path_file(x$path), type)
-
-  # This directory structure is necessary for RStudio to open the
-  # .html file in the help pane (see rstudio/rstudio#11336)
-  doc_path <- fs::path("doc", "html", file)
-  path <- fs::path(tempdir(), ".R", doc_path)
-  fs::dir_create(fs::path_dir(path), recurse = TRUE)
+  path <- fs::path(tempdir(), file)
 
   if (type == "text") {
     topic_write_text(x, path)
     title <- paste(x$pkg, basename(x$path), sep = ":")
     file.show(path, title = title)
   } else if (type == "html") {
     topic_write_html(x, path)
-
-    if (is_rstudio()) {
-      # This localhost URL is also part of getting RStudio to open in
-      # the help pane
-      port <- httpdPort()
-      url <- sprintf("http://localhost:%i/%s", port, doc_path)
-    } else {
-      url <- path
-    }
-
-    utils::browseURL(url)
+    utils::browseURL(path)
   }
 }
 
-on_load(
-  httpdPort %<~% env_get(rlang::ns_env("tools"), "httpdPort")
-)
-
 topic_write_text <- function(x, path) {
-  macros <- load_rd_macros(dirname(dirname(x$path)))
+  macros <- rdtools::pkg_macros(x$pkg)
 
   tools::Rd2txt(
     x$path,
@@ -150,7 +96,7 @@ topic_write_text <- function(x, path) {
 }
 
 topic_write_html <- function(x, path) {
-  macros <- load_rd_macros(dirname(dirname(x$path)))
+  macros <- rdtools::pkg_macros(x$pkg)
 
   tools::Rd2HTML(
     x$path,

R/dev-topic.R

@@ -1,136 +1,40 @@
-# Tools for indexing package documentation by alias, and for finding
-# the rd file for a given topic (alias).
-
-rd_files <- function(path) {
-  path <- pkg_path(path)
-  path_man <- package_file("man", path = path)
-  files <- dir(path_man, pattern = "\\.[Rr]d$", full.names = TRUE)
-  names(files) <- basename(files)
-  sort_ci(files)
-}
+# Tools for finding the Rd file for a given topic (alias). The alias index
+# is maintained by rdtools, which caches it per package until it is reset
+# with `dev_topic_index_reset()` (e.g. by `devtools::document()`).
 
 #' @rdname dev_help
 #' @export
 dev_topic_find <- function(topic, dev_packages = NULL) {
-  topic <- dev_topic_parse(topic, dev_packages)
-
-  for (pkg_name in topic$pkg_names) {
-    path <- dev_topic_path(topic$topic, path = ns_path(pkg_name))
-    if (!is.null(path)) {
-      return(list(path = path, pkg = pkg_name))
-    }
-  }
-
-  NULL
-}
-
-dev_topic_parse <- function(topic, packages = NULL) {
   stopifnot(is_string(topic))
 
-  # Only treat `::`/`:::` as a namespace qualifier when preceded by a valid
-  # package name at the start. Otherwise `::` may appear inside an S7 method
-  # alias like `fn,pkg::Class-method`.
-  m <- regmatches(topic, regexec("^([a-zA-Z][a-zA-Z0-9.]*):::?(.+)$", topic))[[
-    1
-  ]]
-  if (length(m) == 3) {
-    pkgs <- m[[2]]
-    topic <- m[[3]]
-  } else {
-    pkgs <- packages %||% dev_packages()
-  }
+  parsed <- rdtools::topic_split(topic)
+  topic <- parsed$topic
 
-  list(
-    topic = topic,
-    pkg_names = pkgs
-  )
-}
+  # Only search in-development packages, so that a qualified topic like
+  # `stats::mean` falls through to `utils::help()`.
+  packages <- parsed$package %||% dev_packages %||% dev_packages()
+  packages <- intersect(packages, dev_packages())
 
-
-dev_topic_path <- function(topic, path = ".") {
-  # Don't interpret the division operator as a path (#198)
-  if (is_string(topic, "/")) {
+  found <- rdtools::topic_find(topic, packages = packages)
+  if (is.null(found)) {
     return(NULL)
   }
 
-  path <- pkg_path(path)
-
-  # First see if a man file of that name exists
-  man <- package_file("man", topic, path = path)
-  if (file.exists(man)) {
-    return(man)
-  }
-
-  # Next, look in index
-  index <- dev_topic_index(path)
-  if (topic %in% names(index)) {
-    return(package_file("man", last(index[[topic]]), path = path))
-  }
-
-  # Finally, try adding .Rd to name
-  man_rd <- package_file("man", paste0(topic, ".Rd"), path = path)
-  if (file.exists(man_rd)) {
-    return(man_rd)
-  }
-
-  NULL
+  path <- rdtools::topic_rd_path(topic, found$package)
+  list(path = path, pkg = found$package)
 }
 
-
-# Cache -------------------------------------------------------------------
-
-dev_topic_indices <- new.env(parent = emptyenv())
-
 #' @rdname dev_help
 #' @param path Path to package.
 #' @export
 dev_topic_index <- function(path = ".") {
-  path <- pkg_path(path)
-  package <- pkg_name(path)
-
-  if (!exists(pkg_name(path), dev_topic_indices)) {
-    dev_topic_indices[[package]] <- build_topic_index(path)
-  }
-  dev_topic_indices[[package]]
+  rdtools::pkg_topics(pkg_path(path))
 }
 
 #' @rdname dev_help
 #' @param pkg_name Name of package.
 #' @export
 dev_topic_index_reset <- function(pkg_name) {
-  if (exists(pkg_name, dev_topic_indices)) {
-    rm(list = pkg_name, envir = dev_topic_indices)
-  }
-
+  rdtools::pkg_cache_reset(pkg_name)
   invisible(TRUE)
 }
-
-# Topic index -------------------------------------------------------------
-
-build_topic_index <- function(path = ".") {
-  path <- pkg_path(path)
-
-  macros <- load_rd_macros(path)
-  rds <- rd_files(path)
-
-  # Pass `permissive = TRUE` to suppress warnings about unknown
-  # macros (#119). It is unlikely that a macro generates `name` or
-  # `alias` commands, so we shouldn't be missing any topics from
-  # unknown macros.
-  aliases <- function(path) {
-    parsed <- tools::parse_Rd(path, macros = macros, permissive = TRUE)
-    tags <- vapply(parsed, function(x) attr(x, "Rd_tag")[[1]], character(1))
-    unlist(parsed[tags == "\\alias"])
-  }
-
-  invert(lapply(rds, aliases))
-}
-
-invert <- function(L) {
-  if (length(L) == 0) {
-    return(L)
-  }
-  t1 <- unlist(L)
-  names(t1) <- rep(names(L), lapply(L, length))
-  tapply(names(t1), t1, c)
-}

R/utils.R

@@ -157,11 +157,6 @@ strip_internal_calls <- function(x, package) {
   }
 }
 
-sort_ci <- function(x) {
-  local_collate("C")
-  x[order(tolower(x), x)]
-}
-
 dev_packages <- function() {
   packages <- vapply(
     loadedNamespaces(),
@@ -204,8 +199,6 @@ delayed_assign <- function(
   inject(delayedAssign(x, !!value, eval.env, assign.env))
 }
 
-last <- function(x) utils::tail(x, n = 1L)
-
 single_quote <- function(x) {
   encodeString(x, quote = "'")
 }
@@ -235,10 +228,6 @@ is_rstudio <- function() {
   is_string(.Platform$GUI, "RStudio")
 }
 
-rstudioapi_available <- function() {
-  is_installed("rstudioapi") && rstudioapi::isAvailable()
-}
-
 is_windows <- function() {
   .Platform$OS.type == "windows"
 }

tests/testthat/test-examples.R

@@ -31,6 +31,14 @@ test_that("can run example package", {
   expect_equal(env$a, 101)
 })
 
+test_that("dev_example() expands the package's custom Rd macros", {
+  load_all(test_path("testHelp"))
+  defer(unload(test_path("testHelp")))
+
+  env <- dev_example("testExampleMacro", quiet = TRUE)
+  expect_equal(env$a, 303)
+})
+
 test_that("can use system macros", {
   load_all(test_path("testHelp"))
   defer(unload(test_path("testHelp")))
@@ -44,7 +52,7 @@ test_that("can use system macros", {
 })
 
 test_that("can use extra Rd macros", {
-  macros <- load_rd_macros("testHelp")
+  macros <- rdtools::pkg_macros(test_path("testHelp"))
   expect_silent(
     run_example(
       test_path("testHelp", "man", "testCustomMacro.Rd"),