Check package name before making a remote link

I'm not sure how I missed this before, but this has clearly been a problem for a long time.

Fixes #1262

NEWS.md

@@ -1,5 +1,8 @@
 # pkgdown (development version)
 
+* In examples and Rmd, calls of the form `current_package::foo` now get
+  a local link (#1262).
+
 * You can optional suppress the CRAN release dates added to the news page.
   See `build_news()` for details (#1118).
 

R/highlight.r

@@ -53,12 +53,18 @@ href_tokens <- function(tokens, styles) {
   # SYMBOL_PACKAGE must always be followed NS_GET (or NS_GET_INT)
   # SYMBOL_FUNCTION_CALL or SYMBOL
   pkg <- which(styles %in% "kw pkg")
+  pkg_local <- tokens[pkg] == context_get("package")
   pkg_call <- pkg + 2
-  href[pkg_call] <- purrr::map2_chr(
-    tokens[pkg_call],
-    tokens[pkg],
+
+  href[pkg_call[!pkg_local]] <- purrr::map2_chr(
+    tokens[pkg_call[!pkg_local]],
+    tokens[pkg[!pkg_local]],
     href_topic_remote
   )
+  href[pkg_call[pkg_local]] <- purrr::map_chr(
+    tokens[pkg_call[pkg_local]],
+    href_topic_local
+  )
 
   call <- which(styles %in% "fu")
   call <- setdiff(call, pkg_call)

R/html-tweak.R

@@ -144,13 +144,13 @@ tweak_pre_node <- function(node, ...) {
   # Find nodes with class kw and look backward to see if its qualified
   span <- node %>% xml2::xml_find_all(".//span[@class = 'kw']")
   pkg <- span %>% purrr::map_chr(find_qualifier)
-  has_pkg <- !is.na(pkg)
+  local_pkg <- is.na(pkg) | pkg == context_get("package")
 
   # Extract text and link
   text <- span %>% xml2::xml_text()
   href <- rep_along(text, na_chr)
-  href[has_pkg] <- purrr::map2_chr(text[has_pkg], pkg[has_pkg], href_topic_remote)
-  href[!has_pkg] <- purrr::map_chr(text[!has_pkg], href_topic_local)
+  href[!local_pkg] <- purrr::map2_chr(text[!local_pkg], pkg[!local_pkg], href_topic_remote)
+  href[local_pkg] <- purrr::map_chr(text[local_pkg], href_topic_local)
 
   has_link <- !is.na(href)
 

tests/testthat/test-highlight.R

@@ -1,7 +1,8 @@
 context("test-highlight.R")
 
 test_that("can link to external topics that use ::", {
-  scoped_package_context("test")
+  scoped_package_context("test", c(foo = "bar"))
+  scoped_file_context("test")
 
   # Functions
   expect_equal(
@@ -14,6 +15,12 @@ test_that("can link to external topics that use ::", {
     highlight_text("MASS::addterm"),
     "<span class='kw pkg'>MASS</span><span class='kw ns'>::</span><span class='no'><a href='https://rdrr.io/pkg/MASS/man/addterm.html'>addterm</a></span>"
   )
+
+  # Local package gets local link
+  expect_equal(
+    highlight_text("test::foo()"),
+    "<span class='kw pkg'>test</span><span class='kw ns'>::</span><span class='fu'><a href='bar.html'>foo</a></span>()"
+  )
 })
 
 test_that("can link to implicit remote topics with library()", {

tests/testthat/test-html-tweak.R

@@ -111,6 +111,23 @@ test_that("only local md links are tweaked", {
   expect_equal(href[[2]], "http://remote.com/remote.md")
 })
 
+test_that("code linked to local package", {
+  scoped_package_context("test", c(foo = "bar"))
+  scoped_file_context("test")
+
+  html <- xml2::read_html("<pre>
+    test<span>::</span><span class='kw'>foo</span>
+  </pre>")
+  pre <- xml2::xml_find_first(html, ".//pre")
+
+  tweak_pre_node(pre)
+
+  href <- html %>%
+    xml2::xml_find_all(".//a") %>%
+    xml2::xml_attr("href")
+  expect_equal(href, "bar.html")
+})
+
 
 # homepage ----------------------------------------------------------------
 

tests/testthat/test-rd-html.R

@@ -325,8 +325,8 @@ test_that("nested item with whitespace parsed correctly", {
 
 # Verbatim ----------------------------------------------------------------
 
-
 test_that("parseable preformatted blocks are highlighted", {
+  scoped_package_context("test")
   out <- flatten_para(rd_text("\\preformatted{1}"))
   expect_equal(out, "<pre><span class='fl'>1</span></pre>\n")
 })