Merge pull request #2 from SebKrantz/afterch

Afterch
SebKrantz · Jun 1, 2024 · 718f3c6 · 718f3c6
2 parents 0ba8cb6 + 33564fe
commit 718f3c6
Show file tree

Hide file tree

Showing 4 changed files with 40 additions and 7 deletions.
diff --git a/R/build-home-index.R b/R/build-home-index.R
@@ -20,7 +20,7 @@ build_home_index <- function(pkg = ".", quiet = TRUE) {
   render_page(pkg, "home", data, "index.html", quiet = quiet)
 
   strip_header <- config_pluck_bool(pkg, "home.strip_header", default = FALSE)
-  hide_badges <- pkg$development$mode == "release" && !pkg$development$in_dev
+  hide_badges <- FALSE # pkg$development$mode == "release" && !pkg$development$in_dev
 
   update_html(
     dst_path,

diff --git a/R/build-reference-index.R b/R/build-reference-index.R
@@ -1,7 +1,15 @@
 data_reference_index <- function(pkg = ".", error_call = caller_env()) {
   pkg <- as_pkgdown(pkg)
 
+  # This removes shorthands from reference index
+  sh <- getNamespace("collapse")[[".SHORTHANDS"]]
+  sh <- sh[!endsWith(sh, "<-")]
+  sh <- c(sh, paste0("`", sh), ".quantile", ".range", "`[", "`$")
+  pkg$topics$funs <- lapply(pkg$topics$funs, function(y) if(length(y))
+    y[rowSums(do.call(cbind, lapply(sh, startsWith, x = y))) <= 0] else y)
+
   meta <- config_pluck_reference(pkg, error_call)
+
   if (length(meta) == 0) {
     return(list())
   }
@@ -15,7 +23,7 @@ data_reference_index <- function(pkg = ".", error_call = caller_env()) {
   rows <- Filter(function(x) !x$is_internal, rows)
 
   print_yaml(list(
-    pagetitle = tr_("Package index"),
+    pagetitle = tr_("Function Reference"),
     rows = rows,
     has_icons = has_icons
   ))

diff --git a/R/rd.R b/R/rd.R
@@ -2,18 +2,42 @@ rd_text <- function(x, fragment = TRUE) {
   con <- textConnection(x)
   on.exit(close(con), add = TRUE)
 
-  set_classes(tools::parse_Rd(con, fragment = fragment, encoding = "UTF-8"))
+  set_classes(parse_Rd2(con, fragment = fragment, encoding = "UTF-8"))
+}
+
+parse_Rd2 <- function(file, ...) {
+  substcr <- function(x) gsub("\\cr\\cr", "\\cr", gsub("\\cr \\cr", "\\cr", x, fixed = TRUE), fixed = TRUE)
+  lines <- read_lines(file)
+  if(endsWith(file, "collapse-options.Rd")) {
+    lines <- gsub("\\tab\\tab", "\\tab", gsub("\\tab \\tab", "\\tab", lines, fixed = TRUE), fixed = TRUE)
+    lines <- gsub("\\tabular{lll}", "\\tabular{ll}", lines, fixed = TRUE)
+  }
+  clpns <- getNamespace("collapse")
+  nam <- names(clpns)
+  rm_alias <- c(clpns[[".SHORTHANDS"]],
+                setdiff(nam[startsWith(nam, ".")], c(".", ".c")),
+                nam[startsWith(nam, "[")],
+                nam[startsWith(nam, "$")])
+  rm_alias <- paste0("\\alias{", rm_alias)
+  lines <- lines[!startsWith(lines, "%")]
+  lines <- lines[!startsWith(lines, "\\alias{A")]
+  lines <- lines[rowSums(sapply(rm_alias, startsWith, x = lines, USE.NAMES = FALSE)) <= 0]
+  tmp <- tempfile(fileext = ".Rd")
+  write_lines(substcr(substcr(substcr(substcr(substcr(lines))))), tmp)
+  res <- tools::parse_Rd(tmp, ...)
+  file.remove(tmp)
+  res
 }
 
 rd_file <- function(path, pkg_path = NULL) {
   if (getRversion() >= "3.4.0") {
     macros <- tools::loadPkgRdMacros(pkg_path)
-    set_classes(tools::parse_Rd(path, macros = macros, encoding = "UTF-8"))
+    set_classes(parse_Rd2(path, macros = macros, encoding = "UTF-8"))
   } else if (getRversion() >= "3.2.0") {
     macros <- tools::loadPkgRdMacros(pkg_path, TRUE)
-    set_classes(tools::parse_Rd(path, macros = macros, encoding = "UTF-8"))
+    set_classes(parse_Rd2(path, macros = macros, encoding = "UTF-8"))
   } else {
-    set_classes(tools::parse_Rd(path, encoding = "UTF-8"))
+    set_classes(parse_Rd2(path, encoding = "UTF-8"))
   }
 }
 

diff --git a/R/tweak-homepage.R b/R/tweak-homepage.R
@@ -115,7 +115,8 @@ badges_extract <- function(html) {
 
   xml2::xml_remove(x)
 
-  as.character(badges)
+  badges <- as.character(badges)
+  badges[!grepl("download", badges, ignore.case = TRUE)]
 }
 
 badges_extract_text <- function(x) {