Update fork

DESCRIPTION

@@ -8,6 +8,7 @@ Authors@R: c(
            comment = c(ORCID = "0000-0002-6299-179X")),
     person("Maëlle", "Salmon", role = "aut",
            comment = c(ORCID = "0000-0002-2815-0399")),
+    person("Olivier", "Roy", role = "aut"),
     person("Posit Software, PBC", role = c("cph", "fnd"))
   )
 Description: Generate an attractive and useful website from a source

NEWS.md

@@ -1,5 +1,9 @@
 # pkgdown (development version)
 
+* When built on GitHub, source urls now use the name of the current upstream branch (rather than `HEAD`), which is more likely to generate correct links (#2597).
+* New `vignette("non-english")` that discusses non-English sites including how to submit new translations (#2605).
+* `build_reference()` now generates the usage that users actually type for infix and replacement methods (#2303).
+* @olivroy is now a pkgdown author in recognition of his contributions. 
 * `pkgdown_sitrep()`/`check_pkgdown()` now check that you have up-to-date favicons if you have a package logo.
 * pkgdown now uses httr2 instead of httr (#2600).
 * New `template.math-rendering` allows you to control how math is rendered across your site. The default uses `mathml` which is low-dependency, but has the lowest fidelity. You can also use `mathjax`, the previous default, and `katex`, a faster alternative. (#1966).

R/repo.R

@@ -63,7 +63,7 @@ package_repo <- function(pkg) {
   # Use metadata if available
   repo <- config_pluck_list(pkg, "repo")
   url <- config_pluck_list(pkg, "repo.url")
-  branch <- config_pluck_string(pkg, "repo.branch", default = "HEAD")
+
 
   if (!is.null(url)) {
     return(repo)
@@ -77,6 +77,7 @@ package_repo <- function(pkg) {
 
   gh_links <- grep("^https?://git(hub|lab)\\..+/", urls, value = TRUE)
   if (length(gh_links) > 0) {
+    branch <- config_pluck_string(pkg, "repo.branch")
     return(repo_meta_gh_like(gh_links[[1]], branch))
   }
 
@@ -96,7 +97,8 @@ repo_meta <- function(home = NULL, source = NULL, issue = NULL, user = NULL) {
 
 repo_meta_gh_like <- function(link, branch = NULL) {
   gh <- parse_github_like_url(link)
-  branch <- branch %||% "HEAD"
+  branch <- branch %||% gha_current_branch()
+
   repo_meta(
     paste0(gh$host, "/", gh$owner, "/", gh$repo, "/"),
     paste0(gh$host, "/", gh$owner, "/", gh$repo, "/blob/", branch, "/"),
@@ -105,6 +107,22 @@ repo_meta_gh_like <- function(link, branch = NULL) {
   )
 }
 
+gha_current_branch <- function() {
+  # Only set in pull requests
+  ref <- Sys.getenv("GITHUB_HEAD_REF")
+  if (ref != "") {
+    return(ref)
+  }
+
+  # Set everywhere but might not be a branch
+  ref <- Sys.getenv("GITHUB_REF_NAME")
+  if (ref != "") {
+    return(ref)
+  }
+
+  "HEAD"
+}
+
 parse_github_like_url <- function(link) {
   supports_subgroups <- grepl("^https?://gitlab\\.", link)
   rx <- paste0(

R/usage.R

@@ -1,10 +1,27 @@
 # Reference page ---------------------------------------------------------------
 
+# For testing
+usage2text <- function(x) {
+  rd <- rd_text(paste0("\\usage{", x, "}"), FALSE)[[1]]
+  strip_html_tags(as_data(rd))
+}
+
 #' @export
 as_data.tag_usage <- function(x, ...) {
   text <- paste(flatten_text(x, ..., escape = FALSE), collapse = "\n")
   text <- str_trim(text)
 
+  # Look for single line calls to non-syntactic functions and then use
+  # deparse1 to convert to standard style. We want to avoid reparsing 
+  # any other lines to avoid losing whitespace, comments etc. (These
+  # are not generated by roxygen but can be added by the user.)
+  lines <- strsplit(text, "\n", fixed = TRUE)[[1]]
+  parsed <- lapply(lines, function(x) tryCatch(parse(text = x)[[1]], error = function(e) NULL))
+  needs_tweak <- vapply(parsed, function(x) is_call(x) && !is_syntactic(x[[1]]), logical(1))
+  lines[needs_tweak] <- vapply(parsed[needs_tweak], deparse1, character(1))
+
+  text <- paste(lines, collapse = "\n")
+
   highlight_text(text)
 }
 
@@ -16,15 +33,21 @@ as_html.tag_S3method <- function(x, ...) method_usage(x, "S3")
 as_html.tag_S4method <- function(x, ...) method_usage(x, "S4")
 
 method_usage <- function(x, type) {
-  fun <- as_html(x[[1]])
-  class <- as_html(x[[2]])
+  # Despite these being called from the as_html() generic, the target isn't
+  # actually HTML, but R code, which is turned into HTML by the syntax
+  # highlighting in as as_data.tag_usage()
+  fun <- as_html(x[[1]], escape = FALSE)
+  class <- as_html(x[[2]], escape = FALSE)
 
   if (x[[2]] == "default") {
     method <- sprintf(tr_("# Default %s method"), type)
   } else {
     method <- sprintf(tr_("# %s method for class '%s'"), type, class)
   }
 
+  if (!is_syntactic(fun)) {
+    fun <- paste0("`", fun, "`")
+  }
   paste0(method, "\n", fun)
 }
 

inst/BS5/assets/pkgdown.scss

@@ -438,9 +438,16 @@ pre, pre code {
   word-wrap: normal;
 }
 
-[data-bs-theme="dark"] pre {
-  background-color: RGBA(var(--bs-body-color-rgb), 0.1);
-  border-color: var(--bs-border-color);
+// Default dark mode styling does not look good for code
+[data-bs-theme="dark"] {
+  pre, code {
+    background-color: RGBA(var(--bs-body-color-rgb), 0.1); 
+  }
+  // don't double apply transparency
+  pre code {
+    background: transparent;
+  }
+
 }
 
 code {

pkgdown/_pkgdown.yml

@@ -12,8 +12,6 @@ authors:
     href: http://hadley.nz
   Posit Software, PBC:
     href: https://www.posit.co
-    html: >-
-      <img src='https://www.tidyverse.org/posit-logo.svg' alt='Posit' width='62' height='16' style="margin-bottom: 3px;" />
 
 template:
   bootstrap: 5
@@ -35,6 +33,7 @@ articles:
   navbar: ~
   contents:
   - customise
+  - translations
   - accessibility
   - linking
   - metadata

tests/testthat/_snaps/usage.md

@@ -1,15 +1,18 @@
-# usage escapes special characters
+# usage generates user facing code for S3/S4 infix/replacement methods
 
     Code
-      # Parseable
-      cat(strip_html_tags(usage2html("# <>\nx")))
+      cat(usage2text("\\S3method{$}{indexed_frame}(x, name)"))
     Output
-      # &lt;&gt;
-      x
+      # S3 method for class 'indexed_frame'
+      x$name
     Code
-      # Unparseable
-      cat(strip_html_tags(usage2html("# <>\n<")))
+      cat(usage2text("\\method{[[}{indexed_frame}(x, i) <- value"))
     Output
-      # &lt;&gt;
-      &lt;
+      # S3 method for class 'indexed_frame'
+      x[[i]] &lt;- value
+    Code
+      cat(usage2text("\\S4method{>=}{MyType,numeric}(e1, e2)"))
+    Output
+      # S4 method for class 'MyType,numeric'
+      e1 &gt;= e2
 

tests/testthat/test-repo.R

@@ -47,6 +47,7 @@ test_that("Jira issues are automatically linked", {
 # repo_source -------------------------------------------------------------
 
 test_that("repo_source() truncates automatically", {
+  withr::local_envvar(GITHUB_HEAD_REF = "HEAD")
   pkg <- list(repo = repo_meta_gh_like("https://github.com/r-lib/pkgdown"))
 
   expect_snapshot({
@@ -81,6 +82,7 @@ test_that("repo_source() uses the branch setting in meta", {
 # package_repo ------------------------------------------------------------
 
 test_that("can find github from BugReports or URL", {
+  withr::local_envvar(GITHUB_HEAD_REF = "HEAD")
   expected <- repo_meta_gh_like("https://github.com/r-lib/pkgdown")
 
   pkg <- local_pkgdown_site(desc = list(
@@ -103,11 +105,27 @@ test_that("can find github from BugReports or URL", {
 })
 
 test_that("can find gitlab url", {
+  withr::local_envvar(GITHUB_HEAD_REF = "HEAD")
   url <- "https://gitlab.com/msberends/AMR"
   pkg <- local_pkgdown_site(desc = list(URL = url))
   expect_equal(package_repo(pkg), repo_meta_gh_like(url))
 })
 
+test_that("uses GITHUB env vars if set", {
+  withr::local_envvar(GITHUB_HEAD_REF = NA, GITHUB_REF_NAME = "abc")
+  expect_equal(
+    repo_meta_gh_like("https://github.com/r-lib/pkgdown")$url$source,
+    "https://github.com/r-lib/pkgdown/blob/abc/"
+  )
+
+  withr::local_envvar(GITHUB_HEAD_REF = "xyz")
+  expect_equal(
+    repo_meta_gh_like("https://github.com/r-lib/pkgdown")$url$source,
+    "https://github.com/r-lib/pkgdown/blob/xyz/"
+  )
+
+})
+
 test_that("GitLab subgroups are properly parsed", {
   issue_url <- function(...) {
     pkg <- local_pkgdown_site(desc = list(...))
@@ -124,6 +142,8 @@ test_that("GitLab subgroups are properly parsed", {
 })
 
 test_that("can find github enterprise url", {
+  withr::local_envvar(GITHUB_HEAD_REF = "HEAD")
+
   url <- "https://github.acme.com/roadrunner/speed"
   pkg <- local_pkgdown_site(desc = list(BugReports = url))
   expect_equal(package_repo(pkg), repo_meta_gh_like(url))

tests/testthat/test-usage.R

@@ -2,17 +2,26 @@
 # Reference --------------------------------------------------------------------
 
 test_that("usage escapes special characters", {
+  # parseable
+  expect_equal(usage2text("# <"), "# &lt;")
+  #unparseable
+  expect_equal(usage2text("<"), "&lt;")
+})
+
+test_that("usage re-renders non-syntactic calls", {
+  expect_equal(usage2text("`<`(x, y)"), "x &lt; y")
+  expect_equal(usage2text("`[`(x, y)"), "x[y]")
+})
 
-  usage2html <- function(x) {
-    rd <- rd_text(paste0("\\usage{", x, "}"), FALSE)[[1]]
-    as_data(rd)
-  }
+test_that("usage doesn't re-renders syntactic calls", {
+  expect_equal(usage2text("foo(x , y) # hi"), "foo(x , y) # hi")
+})
 
+test_that("usage generates user facing code for S3/S4 infix/replacement methods", {
   expect_snapshot({
-    "Parseable"
-    cat(strip_html_tags(usage2html("# <>\nx")))
-    "Unparseable"
-    cat(strip_html_tags(usage2html("# <>\n<")))
+    cat(usage2text("\\S3method{$}{indexed_frame}(x, name)"))
+    cat(usage2text("\\method{[[}{indexed_frame}(x, i) <- value"))
+    cat(usage2text("\\S4method{>=}{MyType,numeric}(e1, e2)"))
   })
 })
 
@@ -54,6 +63,13 @@ test_that("default methods get custom text", {
   expect_equal(out[1], "# Default S4 method")
 })
 
+test_that("non-syntactic functions get backquoted, not escaped", {
+  out <- rd2html("\\S3method{<}{foo}(x, y)")
+  expect_equal(out[[2]], "`<`(x, y)")
+
+  out <- rd2html("\\S4method{bar<-}{foo}(x, y)")
+  expect_equal(out[[2]], "`bar<-`(x, y)")
+})
 
 # Reference index --------------------------------------------------------------
 

vignettes/.gitignore

@@ -2,3 +2,5 @@
 *.R
 *.log
 *_files
+
+/.quarto/

vignettes/pkgdown.Rmd

@@ -54,27 +54,6 @@ template:
 
 You can learn more about controlling the appearance of your site in `vignette("customise")`.
 
-### Language
-
-If your documentation (`.Rd` and `.Rmd`) is written in a language other than English, declare it by setting setting `lang` to the [two letter language code](https://en.wikipedia.org/wiki/List_of_ISO_639-1_codes) for your language:
-
-``` yaml
-lang: fr
-```
-
-This will be used to set the language of the web page and to translate the English words that pkgdown generates on your site.
-Current available translations are:
-
--   `ca`: Catalan
--   `de`: German
--   `dk`: Danish
--   `es`: Spanish
--   `fr`: French
--   `ko`: Korean
--   `pt`: Portuguese
--   `tr`: Turkish
--   `zh_CN`: Chinese (simplified)
-
 ## Accessibility
 
 pkgdown's defaults work to ensure that your site is accessible to as many people as possible. But there are some accessibilty issues that only a human can solve, so make sure to also read `vignette("accessibility")` to learn about them.