From 15ca334c450d6776aeed9c5f5ed64145e7479bee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 11 Jun 2020 01:14:02 +0100 Subject: [PATCH 01/23] Link to files, not topics #1: external links --- R/markdown-link.R | 31 +++++++++++++++--------- R/utils.R | 25 +++++++++++++++++++ tests/testthat/test-markdown-link.R | 19 ++++++++------- tests/testthat/testNamespace/DESCRIPTION | 2 +- 4 files changed, 55 insertions(+), 22 deletions(-) diff --git a/R/markdown-link.R b/R/markdown-link.R index 3eb92272c..d45661f4c 100644 --- a/R/markdown-link.R +++ b/R/markdown-link.R @@ -4,18 +4,23 @@ #' spaces between the closing and opening bracket in the `[text][ref]` #' form. #' +#' Starting from R 4.0.2-ish, links to topics are not allowed, so for each +#' linked topic, we look up the linked file and check if the file name is the +#' same as the topic name, and generate the longer form for `[obj]` style +#' links. +#' #' These are the link references we add: #' ``` #' MARKDOWN LINK TEXT CODE RD #' -------- --------- ---- -- -#' [fun()] fun() T \\link[=fun]{fun()} -#' [obj] obj F \\link{obj} -#' [pkg::fun()] pkg::fun() T \\link[pkg:fun]{pkg::fun()} -#' [pkg::obj] pkg::obj F \\link[pkg:obj]{pkg::obj} -#' [text][fun()] text F \\link[=fun]{text} -#' [text][obj] text F \\link[=obj]{text} -#' [text][pkg::fun()] text F \\link[pkg:fun]{text} -#' [text][pkg::obj] text F \\link[pkg:obj]{text} +#' [fun()] fun() T \\link[=file]{fun()} +#' [obj] obj F \\link{obj} or \\link[=file]{obj} +#' [pkg::fun()] pkg::fun() T \\link[pkg:file]{pkg::fun()} +#' [pkg::obj] pkg::obj F \\link[pkg:file]{pkg::obj} +#' [text][fun()] text F \\link[=file]{text} +#' [text][obj] text F \\link[=file]{text} +#' [text][pkg::fun()] text F \\link[pkg:file]{text} +#' [text][pkg::obj] text F \\link[pkg:file]{text} #' [s4-class] s4 F \\linkS4class{s4} #' [pkg::s4-class] pkg::s4 F \\link[pkg:s4-class]{pkg::s4} #' ``` @@ -111,6 +116,7 @@ parse_link <- function(destination, contents, state) { ## `obj` is fun or obj (fun is without parens) ## `s4` is TRUE if we link to an S4 class (i.e. have -class suffix) ## `noclass` is fun with -class removed + ## file is the filename of the linked topic is_code <- is_code || (grepl("[(][)]$", destination) && ! has_link_text) pkg <- str_match(destination, "^(.*)::")[1,2] @@ -121,16 +127,17 @@ parse_link <- function(destination, contents, state) { obj <- sub("[(][)]$", "", fun) s4 <- str_detect(destination, "-class$") noclass <- str_match(fun, "^(.*)-class$")[1,2] + file <- find_topic_filename(pkg, obj) ## To understand this, look at the RD column of the table above if (!has_link_text) { paste0( if (is_code) "\\code{", if (s4 && is.na(pkg)) "\\linkS4class" else "\\link", - if (is_fun || ! is.na(pkg)) "[", - if (is_fun && is.na(pkg)) "=", + if (is_fun || ! is.na(pkg) || file != obj) "[", + if ((is_fun || file != obj) && is.na(pkg)) "=", if (! is.na(pkg)) paste0(pkg, ":"), - if (is_fun || ! is.na(pkg)) paste0(obj, "]"), + if (is_fun || ! is.na(pkg) || file != obj) paste0(file, "]"), "{", if (!is.na(pkg)) paste0(pkg, "::"), if (s4) noclass else fun, @@ -146,7 +153,7 @@ parse_link <- function(destination, contents, state) { if (is_code) "\\code{", "\\link[", if (is.na(pkg)) "=" else paste0(pkg, ":"), - obj, + file, "]{" ), contents, diff --git a/R/utils.R b/R/utils.R index 9251717c4..d9eccbcc7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -161,6 +161,31 @@ uuid <- function(nchar = 8) { ) } +find_topic_filename <- function(pkg, topic) { + # This is needed because we have the escaped text here, and parse_Rd will + # un-escape it properly. + raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) + if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { + # TODO: we need to do this later when the file names are available + topic + } else { + # TODO: include file names and line numbers in warning messages + path <- tryCatch( + basename(utils::help((raw_topic), (pkg))[1]), + error = function(err) { + roxy_warning("Link to unavailable package: ", pkg, ". ", err$message) + topic + } + ) + if (is.na(path)) { + roxy_warning("Link to unknown topic: ", topic, " in package ", pkg) + topic + } else { + path + } + } +} + # quoting ----------------------------------------------------------------- auto_backtick <- function(x) { needs_backtick <- !has_quotes(x) & !is_syntactic(x) diff --git a/tests/testthat/test-markdown-link.R b/tests/testthat/test-markdown-link.R index a78a8a299..8b76352d3 100644 --- a/tests/testthat/test-markdown-link.R +++ b/tests/testthat/test-markdown-link.R @@ -51,7 +51,7 @@ test_that("% in links are escaped", { expect_equal(markdown("[x][%%]"), "\\link[=\\%\\%]{x}") expect_equal(markdown("[%][x]"), "\\link[=x]{\\%}") expect_equal(markdown("[%%]"), "\\link{\\%\\%}") - expect_equal(markdown("[foo::%%]"), "\\link[foo:\\%\\%]{foo::\\%\\%}") + expect_equal(markdown("[base::%%]"), "\\link[base:Arithmetic]{base::\\%\\%}") }) test_that("commonmark picks up the various link references", { @@ -97,13 +97,13 @@ test_that("short and sweet links work", { out1 <- roc_proc_text(rd_roclet(), " #' Title #' - #' See [pkg::function()], [pkg::object]. + #' See [commonmark::markdown_xml()], [commonmark::markdown_xml]. #' @md foo <- function() {}")[[1]] out2 <- roc_proc_text(rd_roclet(), " #' Title #' - #' See \\code{\\link[pkg:function]{pkg::function()}}, \\link[pkg:object]{pkg::object}. + #' See \\code{\\link[commonmark:commonmark]{commonmark::markdown_xml()}}, \\link[commonmark:commonmark]{commonmark::markdown_xml}. foo <- function() {}")[[1]] expect_equivalent_rd(out1, out2) @@ -123,13 +123,13 @@ test_that("short and sweet links work", { out1 <- roc_proc_text(rd_roclet(), " #' Title #' - #' Description, see [name words][pkg::bar]. + #' Description, see [name words][commonmark::markdown_xml]. #' @md foo <- function() {}")[[1]] out2 <- roc_proc_text(rd_roclet(), " #' Title #' - #' Description, see \\link[pkg:bar]{name words}. + #' Description, see \\link[commonmark:commonmark]{name words}. foo <- function() {}")[[1]] expect_equivalent_rd(out1, out2) @@ -249,7 +249,7 @@ test_that("markdown code as link text is rendered as code", { #' Description, see [`name`][dest], #' [`function`][function()], #' [`filter`][stats::filter()], - #' [`bar`][pkg::bar], + #' [`bar`][stats::filter], #' [`terms`][terms.object], #' [`abc`][abc-class]. #' @md @@ -260,7 +260,7 @@ test_that("markdown code as link text is rendered as code", { #' Description, see \\code{\\link[=dest]{name}}, #' \\code{\\link[=function]{function}}, #' \\code{\\link[stats:filter]{filter}}, - #' \\code{\\link[pkg:bar]{bar}}, + #' \\code{\\link[stats:filter]{bar}}, #' \\code{\\link[=terms.object]{terms}}, #' \\code{\\link[=abc-class]{abc}}. foo <- function() {}")[[1]] @@ -366,12 +366,13 @@ test_that("links to S4 classes are OK", { foo <- function() {}")[[1]] expect_equivalent_rd(out1, out2) - out1 <- roc_proc_text(rd_roclet(), " + # pkg::linktos4 is not a proper S4 class, so we ignore a roxy warning here + out1 <- suppressWarnings(roc_proc_text(rd_roclet(), " #' Title #' #' Description, see [pkg::linktos4-class] as well. #' @md - foo <- function() {}")[[1]] + foo <- function() {}")[[1]]) out2 <- roc_proc_text(rd_roclet(), " #' Title #' diff --git a/tests/testthat/testNamespace/DESCRIPTION b/tests/testthat/testNamespace/DESCRIPTION index 4552c154f..c712b8359 100644 --- a/tests/testthat/testNamespace/DESCRIPTION +++ b/tests/testthat/testNamespace/DESCRIPTION @@ -6,4 +6,4 @@ Author: Hadley Maintainer: Hadley Encoding: UTF-8 Version: 0.1 -RoxygenNote: 7.0.2.9000 +RoxygenNote: 7.1.0.9000 From ce56cdd8d6deeb55a9a53be08d5f28d9cacd1dc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 12 Jun 2020 00:30:44 +0100 Subject: [PATCH 02/23] Link to files, for internal links as well --- DESCRIPTION | 2 +- R/markdown-link.R | 3 ++- R/object-s3.R | 2 +- R/rd.R | 1 + R/roxygenize.R | 2 ++ R/topic.R | 25 ++++++++++++++++++++++++- R/topics.R | 17 +++++++++++++++++ R/utils.R | 5 +++-- man/RoxyTopic.Rd | 13 ++++++++----- man/figures/test-figure-1.png | Bin 13681 -> 2364 bytes man/is_s3_generic.Rd | 2 +- man/load_options.Rd | 2 +- man/markdown-test.Rd | 2 +- man/roclet.Rd | 4 ++-- man/roxy_block.Rd | 2 +- man/roxy_tag.Rd | 2 +- man/roxy_tag_rd.Rd | 2 +- man/roxygenize.Rd | 6 +++--- man/tag_parsers.Rd | 4 ++-- 19 files changed, 72 insertions(+), 24 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b37b796b0..35f00c9ed 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -59,5 +59,5 @@ VignetteBuilder: knitr Encoding: UTF-8 Roxygen: list(markdown = TRUE, load = "installed") -RoxygenNote: 7.1.0 +RoxygenNote: 7.1.0.9000 Language: en-GB diff --git a/R/markdown-link.R b/R/markdown-link.R index d45661f4c..72f0c652c 100644 --- a/R/markdown-link.R +++ b/R/markdown-link.R @@ -116,7 +116,8 @@ parse_link <- function(destination, contents, state) { ## `obj` is fun or obj (fun is without parens) ## `s4` is TRUE if we link to an S4 class (i.e. have -class suffix) ## `noclass` is fun with -class removed - ## file is the filename of the linked topic + ## `file` is the file name of the linked topic, if known. Otherwise random + ## id to fill in later. is_code <- is_code || (grepl("[(][)]$", destination) && ! has_link_text) pkg <- str_match(destination, "^(.*)::")[1,2] diff --git a/R/object-s3.R b/R/object-s3.R index 1c4b944a5..08608a350 100644 --- a/R/object-s3.R +++ b/R/object-s3.R @@ -3,7 +3,7 @@ #' @description #' `is_s3_generic` compares name to `.knownS3Generics` and #' `.S3PrimitiveGenerics`, then looks at the function body to see if it -#' calls [UseMethod()]. +#' calls [base::UseMethod()]. #' #' `is_s3_method` builds names of all possible generics for that function #' and then checks if any of them actually is a generic. diff --git a/R/rd.R b/R/rd.R index 462a1e9a2..01f4acd24 100644 --- a/R/rd.R +++ b/R/rd.R @@ -47,6 +47,7 @@ roclet_process.roclet_rd <- function(x, blocks, env, base_path) { topics$drop_invalid() topics_fix_params_order(topics) topics_add_default_description(topics) + topics$add_linkmap() topics$topics } diff --git a/R/roxygenize.R b/R/roxygenize.R index 76bb1a762..997334ba9 100644 --- a/R/roxygenize.R +++ b/R/roxygenize.R @@ -61,7 +61,9 @@ roxygenize <- function(package.dir = ".", load_code <- find_load_strategy(load_code) env <- load_code(base_path) roxy_meta_set("env", env) + roxy_meta_set("link_id", uuid()) on.exit(roxy_meta_set("env", NULL), add = TRUE) + on.exit(roxy_meta_set("link_id", NULL), add = TRUE) # Tokenise each file blocks <- parse_package(base_path, env = NULL) diff --git a/R/topic.R b/R/topic.R index a50e4a3ed..2df41a766 100644 --- a/R/topic.R +++ b/R/topic.R @@ -19,6 +19,10 @@ RoxyTopic <- R6::R6Class("RoxyTopic", public = list( #' @field filename Path to the `.Rd` file to generate. filename = "", + #' @field linkmap Environment that maps topic names to file names, for + #' fixing links. + linkmap = NULL, + #' @description Format the `.Rd` file. It considers the sections in #' particular order, even though Rd tools will reorder them again. #' @@ -36,10 +40,29 @@ RoxyTopic <- R6::R6Class("RoxyTopic", public = list( sections <- move_names_to_front(self$sections, order) formatted <- lapply(sections, format, ...) - paste0( + rd <- paste0( made_by("%"), paste0(unlist(formatted), collapse = "\n") ) + + if (!is.null(self$linkmap)) { + id <- roxy_meta_get("link_id") + idlen <- nchar(id) + fixer <- function(str) { + topic <- substr(str, idlen + 1, nchar(str) - idlen) + filename <- self$linkmap[[topic]] + if (length(filename) == 0) { + roxy_warning( + "Link to unknown topic '", topic, "' in file '", self$filename, "'" + ) + filename <- topic + } + filename[1] + } + rd <- str_replace_all(rd, regex(paste0(id, "(.*?)", id)), fixer) + } + + rd }, #' @description Check if an `.Rd` file is valid diff --git a/R/topics.R b/R/topics.R index e0d562c1c..b0b3c3418 100644 --- a/R/topics.R +++ b/R/topics.R @@ -88,6 +88,23 @@ RoxyTopics <- R6::R6Class("RoxyTopics", public = list( simple_values = function(field) { fields <- lapply(self$topics, function(rd) rd$get_section(field)) lapply(compact(fields), "[[", "value") + }, + + # Add a map from topic names to file names, this is needed for fixing the + # link targets + add_linkmap = function() { + # If no link id, then nothing to do, this only happens in tests + id <- roxy_meta_get("link_id") + if (is.null(id)) return() + + map <- new.env(parent = emptyenv()) + for (i in seq_along(self$topics)) { + self$topics[[i]]$linkmap <- map + filename <- names(self$topics)[i] + filename <- substr(filename, 1, nchar(filename) - 3) # remove .Rd + aliases <- self$topics[[i]]$get_value("alias") + for (al in aliases) map[[al]] <- c(map[[al]], filename) + } } )) diff --git a/R/utils.R b/R/utils.R index d9eccbcc7..ad3e2c4ea 100644 --- a/R/utils.R +++ b/R/utils.R @@ -164,10 +164,11 @@ uuid <- function(nchar = 8) { find_topic_filename <- function(pkg, topic) { # This is needed because we have the escaped text here, and parse_Rd will # un-escape it properly. + # TODO: include file name and line number here as well raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { - # TODO: we need to do this later when the file names are available - topic + id <- roxy_meta_get("link_id") + paste0(id, topic, id) } else { # TODO: include file names and line numbers in warning messages path <- tryCatch( diff --git a/man/RoxyTopic.Rd b/man/RoxyTopic.Rd index bf4026d6a..560a8ab9c 100644 --- a/man/RoxyTopic.Rd +++ b/man/RoxyTopic.Rd @@ -14,6 +14,9 @@ A \code{RoxyTopic} object corresponds to a generated \code{.Rd} file. \code{\link[=rd_section]{rd_section()}} object.} \item{\code{filename}}{Path to the \code{.Rd} file to generate.} + +\item{\code{linkmap}}{Environment that maps topic names to file names, for +fixing links.} } \if{html}{\out{}} } @@ -106,7 +109,7 @@ Query a section. \if{html}{\out{}} } \subsection{Returns}{ -The \link{rd_section} object representing the section, or \code{NULL} +The \link[=rd_section]{rd_section} object representing the section, or \code{NULL} if the topic has no such section. } } @@ -115,7 +118,7 @@ if the topic has no such section. \if{latex}{\out{\hypertarget{method-get_value}{}}} \subsection{Method \code{get_value()}}{ Query the value of a section. This is the value of -the \link{rd_section} object. +the \link[=rd_section]{rd_section} object. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RoxyTopic$get_value(type)}\if{html}{\out{
}} } @@ -212,8 +215,8 @@ Add one or more sections to the topic. \describe{ \item{\code{x}}{Section(s) to add. It may be another \code{RoxyTopic} object, all of its sections will be added; -or an \link{rd_section} object; -or a list of \link{rd_section} objects to add.} +or an \link[=rd_section]{rd_section} object; +or a list of \link[=rd_section]{rd_section} objects to add.} \item{\code{overwrite}}{Whether to overwrite an existing section. If \code{FALSE} then the two sections will be merged.} @@ -233,7 +236,7 @@ Add a section. \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{section}}{\link{rd_section} object to add.} +\item{\code{section}}{\link[=rd_section]{rd_section} object to add.} \item{\code{overwrite}}{Whether to overwrite an existing section. If \code{FALSE} then the two sections will be merged.} diff --git a/man/figures/test-figure-1.png b/man/figures/test-figure-1.png index 037937329c314155a7f5e880baa8b0870e032415..a00aadb7af9d1661d2eee74ea66e920a1724fc1d 100644 GIT binary patch literal 2364 zcmc&$drVVT9KH;rRDmw04nYJb3n&Fdumu!lAPk7SB9tl*MHs~Z`lDV2vji%?pj_U_iiIsaI)Wh6T}=l=5h?#(^teEELg zIhTV1ybU&+Yz6?pz}Ls~H~{FVv_nr9LVjL>`$Hiu$S=eTiU5EF01SXc0!Zjd1uzUK zhY}=!K_a0}MN;{g4_{ya3`UDmF;HWGR3t!!USj|%gG%M|seF)u0T>{I0fKxg@&mx< zgCK-LITRom%Azbw>!3MdDLyCD0bt8k?a+BCCaVEJFU8l>J%ms?C)PxFH73xc$U#_@@O;aI@u=I5m}@DvXqb%Ra#$*%Y%`k!O(t~0cEJ7xl`8DKZ-|{ zy^ssI8fNF$qIi#9Lis4FHH_WCdpwh0cT?bqP%wAF+LUSu&~)e6#iHuU-Hxu9S(Ijc zc)q3f5O>ms&_PFc_le>UO7m8y`!kjsN(vIzZ{PG<>LEX4a>vMU-`UXy8KpEaTyX}X zIGEj$u%1MhkIKhyKRAqNSCF4HWMLoW*lko_y=5*`yh#l=Poim*ffpJD%^vfKjP`|r9Y-BVUtzYTuA}d?1SQK=jG~C6C zj|CM%Z%k(v!$b95n;l8LtIt*axEoPt{Taft*44T~w>ryl6Ns2{a^C8^b&GJ?ZEM`0 zTC5s&CypC-Av1$mi=P&xtyd08widA*r*fJg#nCkSV6Kz{%Dxu`Jd;bn)Ec}M^iPAL zsC6yua%X9Gb7oR39ZPuf-hZQ>0a(as-^H{lN%j6+=X@NgKK?2NCCjgU6q(;8ukv)} zW0^EgjT?W5=K7ul5}UA4#e6nH?48v+;KG|;SKFD`IU|Sosx)P1@>wa!_9PJpyi76>_%}X_A6IHBF z4=XU1IIB}83+UIi4rMFK^)b`sm}z`rY_t>w+qlKx8~?zmU;H`X55o_%&@CMJoZ+~3=}n~ z_iC1im%#X;%9$AOUd_D~9_5njbal?&`YJUSFY&iC*9^{!?6U5>o#a(_R+vQxJ`W{= zi0s#5!9q_#@}@Z)d0&6U;vDk`t6yf`2Um>0Plg#P_TorJ53{`#yd6J17#%GSOiz7_^6 zj$M&+EpdV4`U5J2I2<<8J9pf4`j;M6hEC7B3Jo!>qlmtXRBPf*=@hpruTZ+2^OTES z=l|7-nWn08%P$?}mbf^oZ%Fr-$mfKzp`t7-bF7m$Q_Krq$R!=gVNFSmy62g;{xdO4 zUl0OL9ai6Xon3RXERQqOn!zWpmAmj8C5iE%;>)$}6UGkecV#1$G>aUiZ81WLe_ANz zlrHY`R*9?3$(NnfOHO`ZxQw=q^AKEHDU?!=mk8TA3jd_1(!PIs3sAtn X%XC*=^D`A_Z$Z9Z0iG<6sPlgSoLqOD^6j6GWB1lmXM5MPU2qIOHCRK_^mo7C#R5}Pqld3*|bm^U-G!X&m zNN-B-9Rm6GNuGD^{pY^_d^30E-up1aBqupJXYYO1TEDV(h?a&j1sO9L0RaJp%3Z|= z1O%`H=%0ibe3He7MG_DYGTA67XxS+!D>&IZxoAIoY+=k_y-Px*_T;_h z9W7tsrDWP>bY%bs-|mG`xiXldGJ6 zgw2yVftkKwA{}kp-~`I3A1wz;=Z=Lx51MAE+b-uW{Qh8`>^`1R{A~U4X}ZIgr?0jh znzFl-(&b*RKQ=n%7v-LxzTd2x8nKyoWS$MH)soJnL9=pDfrnLHWmheOR~>HDlU^IjQQ(8&7>h{NT1m^i3^ z1$LXpC<&T*lnkZ=sa9}_Vx;^u9Lb%!!4Td%LO+F@|*@$FbzWQm@5?AKai%%5j;Zlg?AMH`biFNbG9-yQPKTPmHg>sYO234jOTI z#6q+_u@kkEe53XPjiI1&%JI3z2KmjEW5JooGJ^Pv0jM@EN5<~&XD5gxwqK5vjDBH_ zzUxaq)xW>8hd#RT-2bG1aje-jfBsrPxwv#HdUD-uP!563Be0G@!ZOl*bcu@SB^~isu(~3gAjf|3VBNF$@p>-PuGyQsN zfE)UhgJX*I4D^b~cnOC$ybR1$#T|ix6aO=C`2Us_A1S;1A{~pFFZSMDito4bAaUORcYT1}>vNI}O!o@}=8D>FQJ~V`eR|)NZ zVyp4fylW~}WdCu~>y{+zGy_*lI%*KOhz{E4tK~!Ho$o}e-6muYjD~gY;Uctzj&kGI z(bZI3T+VTFOu0VRyMl|xZ@P#^>*YK*Tr9o`3kc|bWt@qNKn_FHS0djn$NdX(2OOg& z{P-WgHOiobpWdY}E=Wr54ML^dEbdiI6LdDNk@Ww{8= zrp)U8Fq}nPFfaGUl}gHl1)`kq~Ffc0Kb&y+C_H%gU5A8OL>dzK}li` zk9bn`_;4%uiRanzYGt;m@aTrz=Q**>pYIj=*59(B(jW&~Yyx$E8TuRRyj!Pl3qSyZ#=+AYf<>%9|P+9j2@KMv;tPJZ{ z*c+7V#N(VIw zF`LWAPDHrXc&dS#Tdy?rSuGbfZw_7ni{b4qAsMJS!KEvteF-jCy`EMl?R>B?y=Xlp zA2x5ilTIhB3B{-Z`MHY{*X!rg++_{oOoIc^i&@FNp8SOdr96%ehkx>qa*c2?`qP|{ zY*X?;QQC{fXlvD--EZf9*q5RE`1p-OfH}o>aZj3wJI^%dALac0n-7F!uEdic`rYGk z8DJ^EF(pE*D}&Df1w`Zg`$7%;6^cOyFzRpOGvERYmL60ig?|pMaJZa>SqlvW5GWZ! zLSMF}C44k7k&_&Rqv&wcAlw3l-s@9d?EmQ-XaWg6) zz==&c6DmZFN`%A|%(R}9ex5&4Bt^z=kYe%*Yp$M`*=USdvDy7YQgs$BX}fm`3J4x@ zxAh6xwYu#tiG_^7nZIH+LP5pL>_+d`uZva-NZT7B8lA?z(L)RHQw zBMyQB0+c-Equ(4sC)xe56;4xrQCzvA|z|&n2YKd5_{5n2jd=a$B7NcX|*d874$AlRh8}on)|>?c&`*!|d^@t?&G^Z?!c-ewA7)r_1>* zmD`Qfzkt?6N~YexZn9&k`m)sX z?rrV#X)3$uGy9^nd%xS@J>$q#6n>Zr=P(L^TJHvox1n3uaN#S)f zSWvcf-z}Bdr*)XEj^b{)!a!2#7+Nub|a7filEsrlwi%Vu@ApJ0rt2Ks2AsP}l0hDR;chP}*Y0Fcvd7w889q|MaXDLVjww6t0yZ38X(<3LpO*Id}Dxqqq^*@{4!W^{8M{=viE3Qw}&*qnQg%(t}m^{=A9Dc#FeAnSiV9_!m zNxtb6U~(bo(`9rdtLK>TYYG;65$mq-lf6+P-GWEur>Xguv^c=?%=q$?7ETz-_3U?? zUh6OGbk^*2fA5|3N%^(v`7{ZT!Lxvm@oR9EzicEXB*YLu%jZO7{3e6aaSxnM7H}(& zxCL{#%^#n1N$VlFV1IOvAe_*JZrE!+)#7MpkZq zEykEct`8O%V&;*j)uc2!Kx9n-0&# zRsa|CsJO?22Re`fV+%TJxcDuh0kY?x8~wYb8?n?YgBDfGcnSnp*nB!t4l3`w>Ao)Z z^}B-u;$?3MP@VLAD@>TJ-yIf!^CyoBOH*@bsi8J!+uB+fOjBMT^=Znp0?DN63j|n; zeZDT$Ckv?Vjyj=Pn_g3dS*QDn(F^EPP96vnoog@H&~fb?jDb&9i6id(Nr#C95>W-?HHZ(~QwJn2qjg`zfy&6|%$Gi{8qRi!H3 zeb6Aee{{}d0_d7N$7CaFqq3*>aagLwf)X^YX(kt{)4FfqLe#AofPl0w^~qZ8I-BRX zyWU9cm%y`aWj1}xK2lcS-!6>Tdd^~Arx-zJEUaeq}gJh=$$w=9~;VMu@EWo;k zfgxO9tD21*w#_Rr2Rb`CWjdLJ@)Hsz<}lK%i9G6qlzWQ*(PDH;k162X!e)&DN9!qU zlzfSZOYjE3wIOAmDCg&m*{ejWueV`aOfh%7|M>q9Zd2S+{Q_ntNf;B=Z0y=8`gKN*2W}Hv?Gfej%<&V%}z0PmSKGq*YL1Q zcxq&p8n6!hfTK2!H1DOH=gS3^y~msF20kv6CvOzahs?#)<2^)5zKTXESo%%z!zKZR z*XOQybd*QpWiUie#zn@+dXXbdVR><#+Ny}}Kzb7aKc9^Kx#TG6gFAWLUv7xYnNmXkOg;N_{>6&219Wi0cfeOn{$OPYC!&K&3}(#}9R}4r$Pg3RPZF_K0(6&b#JrOe!C?m* zS}&p3l|wO;TuzvY_3Q#AisL88)VYRRU%7A(lP?;W=RIaiWVoZJV1+5D+3@He0sudR zSX&RzSOdW-zS+2o3$A;Yfj@sUvF0}Jh#8z0_);1Fm^r~@KYZy26kyVJx78EfIHpwv^jZ3z-pkgIFz3%=BcXSgxb7ImcT;yda0zR!6n8S}hx`k*I zzxx~?4BXV9b-=77i3Yj*@#0wff;w%Yfdgd}AM)K_B6nF}(MfKB+5U!*n`3~l5us-uS7)G?1y2VsDJj6kKO zIJYuwPWY_TWrmCZ>jt$;R%WpNj=2!RMnGmie`tk7)6zg57wHj@hH^Y=iCV=CBR>qC z>gm?&wl&IiHUYY}g0h!eSo#Jb3T#fmBDNrw+c(h8g!%lqY39pW_VChfx!Msy$PCT6 z4#E57I_1cVOxbDPw&&R8WLlDByj)~<`?YbDV7Pde2UUN1w7j`&imh3y0H&&k8$i(| zDRR<>GzSN>Q5L{8F3=yScAeJ;;NNlsDqDOX0Cf8Q%(%6=QrewmeW%^(5DZeZ#(kMS zRmwdyP1eV;WE66*AQ^iBd7$tkS-fcEY6r6B&Y@hMCOQaJQ+KPmp`3da<`><_%~eE?GP!MTqb z_!Pbe&Rcwp$IG|3K?<8QxO zPpH!_0Ov<$>l;_G@8MRfY_?hwHAsD@l>L{`)2c9POkSxN(;`);WV~*MxacwbxVY)O zbhD=aR&1iQrz5a#xPUnAfBC>3*X3fNc}9#DzO(D%L}5O0>jEG;6X!K z>#*ld3vdDzF92|cJIX)OPab%+oQJ|t5Fy0iT~npbI(T;aO$Rguz8AURLhVfi5TdO* zIk-UK&;vr0AN?HYaaf;J*a%!Z4Y2eEnt zk9$ta9__EQqcOjQ@|^5(9PX`22Bq}|1Xs*zz=X6P1J;G}w@X3I;Y=dE8COq8ZYrGB z%h#vMPI0-%yio7Gdrvh*9_f#1lE)|j0FWyNq)c4lS}0UMP~OyhijA7dV%JPS6A)^M z8F~D&DxOdCX}zz^N(T%e`xL^A@mxDwx?{RL28I;gDz}3p|{JP|HhZI+2eP+lqP-F>ksnKM|l$4KSacXhiVcl??>7Aff zu+N5ds=IEA?^ZhmiLGpqm+U+f!rKafb*Sn`>=K+++C$Bhgxh*mQ~tya@{XN<-a6Z| zn4QiB`WX2Qu{fHnWsAC<@`c@NE;_pIjBi(pB;9a=iMP!~?}hh^HKBA*2B{>bU()pE zaXH{GpuCJpjT+#}@HGW!mRh{l?@dp)5{B-x%RGN}Sw1U*{2b$Tju>_t z9IOCKz`F@|Iw8r;BESVrG&Av_a2sUc?Q?-jcu@EQQm}J5=Wl6B0w5yz@lO(5e*dfk zNZ=(Kr-WMpG5|p2!snRr0Q61|P`je+UOZ4;08Unj1d^!EY2I}hN2ZyZIzmH|d7x2HSHLqb3j zm7!z{@S^n)vL^$uP}3YVE1t~KkJ^{2L&izWZyr2zu!OQQ>SPbP;>XN&E;5Z zC-)KZcfL{ejq|cQKRd6wfm9a;dkuzdvQx$Eu-AU&v=CzAIR^R~F34k^)gAsxUSw~{ z$@XBVF9DG!fV#|O&4mE~Xogt#(O@heOUm*W{C%=aF?d1&vvWiSlP zyM6`N<*W!a_GH}x0K=!`y+H*924Gtn*Lp+%e|rdg{UPEMYb~O-dxSM@w04!@i^DyH zxvNvue*X=?k6P0ZvIJi0X{Mf#qheg<DI%{)r%WrSoBilu~WkinlR#}Sb_a2S8 z^{G35CFN}fUiE{gS74?K)4z6FS3z6Pxl?qgdC<@)_4Kl}vZl;ta~6YH$1WLE1G)gq zeL9dk;9Xg4-iPyMp#4g|*yBk}q@*KcOZ)7tEKJlNXVIDE<-*As1j7p|My{TqCxLbH z6j(P<(_W{t{MiY-U8h?mmZt?cx}1_?Sl^@HLP#da5$T&e1BEppB9c$KQV!>nY1gU) zgvQ?3n*_$Fy0#nKzj4j5LIBsw*&DVHFS_m{N``Chg48-#(nF5`gzaQV6n8SQ2L*An z8;j|-`NWH)wZR;K#&d?OHVV?h9-y-;0ouB=jb|=|LzbU#+eL-!5O_QJN7Iufy<*_1 z>8&IgwHOwg-)V8E5%QfT7e=09LRUk@xTeCyI1Pu>=IEZfAVo+qG@3HbOi^1Z2JRPP#&&C_VF-?s$gsr;ZE#b&7QQc)`%*gaVJBr^)^BlBZ80RxIY zEm0E;q(9lZ-}y|e^urv3<<|YgIbN@xe&8MKcnuXAicsZuFOZ7x> znD$K#bU~H!%s>a?U=n*W$tdUh9CC+on+=Y3ml>d5*~kLeywrL)pUy75@>$^`DDRLN zCg$-3h+bS-1V$SJ&;*_`rw6l(HBht8xs8>fy`kL=LIJ1?oz;D!5P(<(lykLn;4UzB zIueAU(oa^bd%&d+I-UG!&R%?m0Gfx#VKfSfnY~%X4z`vYba^(=0K3@EejCuFk6=qC zR5PKSoU>(p8mdDSEMfvCU}9CE1kGm4pV&NlvIPhGvk`J|hpiml0uU^>GF<1ooEI|_ zveZ?&s$#EeW&w$E9imWxHmD%|cRsRbb}$H;q`daqdSRCAP!R%ZlrYrP+WCQYnrv_e zdDjYdQ!+!F!LDd$DT2b>cY^uPlerED-A6wQL(t4jBz7&C>J*<0hn*q5SvU&z(e%x? zXC6Uz+v6bC!74$ot+`lDCF%{(Xi*Vbt^{t$9#Dm$4nKfLZU|U|p;I{(-&+Lr;6N6e ztame@puHV??MGlciQ@j+cwgz^+?KBkwqbhwpk4OR(%{Ak*wX^}9nD~qQ184#(0TQQ z;~)am2s!A6`M8Qw^VK!#fej;&l_vn80MNzJ1Erd|7@v|gAaFGld?)I>Ac2^*Kbs(E z%nX5w#aNYdv{A2S8gGXhh!)@=Y&+}mqi&O5cB+7C?#|k{v~1WUa4VTdeKuPd+L}XX zW`(d@LO6VYT7va5fY>1AV^j}Kk4J`PhApDhg*N}b+RvpZcAG}: giving names of roclets to run. See \code{\link[=roclet_find]{roclet_find()}} for details. \item \code{packages} \verb{}: packages to load that implement new tags. -\item \code{load} \verb{}: how to load R code. See \link{load} for details. +\item \code{load} \verb{}: how to load R code. See \link[=load]{load} for details. \item \code{old_usage} \verb{}: use old style usage formatting? \item \code{markdown} \verb{}: translate markdown syntax to Rd? \item \code{r6} \verb{}: document R6 classes? diff --git a/man/markdown-test.Rd b/man/markdown-test.Rd index a25f15278..da81e779f 100644 --- a/man/markdown-test.Rd +++ b/man/markdown-test.Rd @@ -6,7 +6,7 @@ \description{ Links are very tricky, so I'll put in some links here: Link to a function: \code{\link[=roxygenize]{roxygenize()}}. -Link to an object: \link{roxygenize} (we just treat it like an object here. +Link to an object: \link[=roxygenize]{roxygenize} (we just treat it like an object here. } \details{ Link to another package, function: \code{\link[devtools:document]{devtools::document()}}. diff --git a/man/roclet.Rd b/man/roclet.Rd index 66e332ffc..520a3e282 100644 --- a/man/roclet.Rd +++ b/man/roclet.Rd @@ -24,7 +24,7 @@ roclet_tags(x) \arguments{ \item{x}{A \code{roclet} object.} -\item{blocks}{A list of \link{roxy_block} objects.} +\item{blocks}{A list of \link[=roxy_block]{roxy_block} objects.} \item{base_path}{Path to root of source package.} @@ -52,7 +52,7 @@ any files created by the roclet. } \subsection{Deprecated methods}{ -\code{roclet_tags()} is no longer used; instead provide a \code{\link[=roxy_tag_parse]{roxy_tag_parse()}} +\code{roclet_tags()} is no longer used; instead provide a \code{\link[=roxy_tag]{roxy_tag_parse()}} method for each tag. } } diff --git a/man/roxy_block.Rd b/man/roxy_block.Rd index 96ded7572..cad16c3dd 100644 --- a/man/roxy_block.Rd +++ b/man/roxy_block.Rd @@ -19,7 +19,7 @@ block_get_tag(block, tag) block_get_tag_value(block, tag) } \arguments{ -\item{tags}{A list of \link{roxy_tag}s.} +\item{tags}{A list of \link[=roxy_tag]{roxy_tag}s.} \item{file, line}{Location of the \code{call} (i.e. the line after the last line of the block).} diff --git a/man/roxy_tag.Rd b/man/roxy_tag.Rd index 32ae1a8c1..b4570ffed 100644 --- a/man/roxy_tag.Rd +++ b/man/roxy_tag.Rd @@ -31,7 +31,7 @@ a list. Usually filled in by \code{tag_parsers}} } \section{Methods}{ -Define a method for \code{roxy_tag_parse} to support new tags. See \link{tag_parsers} +Define a method for \code{roxy_tag_parse} to support new tags. See \link[=tag_parsers]{tag_parsers} for more details. } diff --git a/man/roxy_tag_rd.Rd b/man/roxy_tag_rd.Rd index c708a3905..41ae8328f 100644 --- a/man/roxy_tag_rd.Rd +++ b/man/roxy_tag_rd.Rd @@ -14,7 +14,7 @@ roxy_tag_rd(x, base_path, env) \item{env}{Environment in which to evaluate code (if needed)} } \value{ -Methods must return a \link{rd_section}. +Methods must return a \link[=rd_section]{rd_section}. } \description{ Provide a method for this generic if you want a tag to generate output diff --git a/man/roxygenize.Rd b/man/roxygenize.Rd index 0d26b2ef2..ff5dddf6f 100644 --- a/man/roxygenize.Rd +++ b/man/roxygenize.Rd @@ -19,8 +19,8 @@ which defaults to \code{c("collate", "namespace", "rd")}.} \item{load_code}{A function used to load all the R code in the package directory. The default, \code{NULL}, uses the strategy defined by -the \code{load} roxygen option, which defaults to \code{\link[=load_pkgload]{load_pkgload()}}. -See \link{load} for more details.} +the \code{load} roxygen option, which defaults to \code{\link[=load]{load_pkgload()}}. +See \link[=load]{load} for more details.} \item{clean}{If \code{TRUE}, roxygen will delete all files previously created by roxygen before running each roclet.} @@ -38,6 +38,6 @@ for more details. \details{ Note that roxygen2 is a dynamic documentation system: it works by inspecting loaded objects in the package. This means that you must -be able to load the package in order to document it: see \link{load} for +be able to load the package in order to document it: see \link[=load]{load} for details. } diff --git a/man/tag_parsers.Rd b/man/tag_parsers.Rd index a5a425394..5389341dd 100644 --- a/man/tag_parsers.Rd +++ b/man/tag_parsers.Rd @@ -41,7 +41,7 @@ tag_markdown(x) tag_markdown_with_sections(x) } \arguments{ -\item{x}{A \link{roxy_tag} object to parse} +\item{x}{A \link[=roxy_tag]{roxy_tag} object to parse} \item{first, second}{Name of first and second parts of two part tags} @@ -53,7 +53,7 @@ tag_markdown_with_sections(x) \item{min, max}{Minimum and maximum number of words} } \value{ -A \link{roxy_tag} object with the \code{val} field set to the parsed value. +A \link[=roxy_tag]{roxy_tag} object with the \code{val} field set to the parsed value. } \description{ These functions parse the \code{raw} tag value, convert a string into a richer R From 501d8a5b423040a6bf30b8ff7b0ed0f11dea9923 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 12 Jun 2020 00:50:40 +0100 Subject: [PATCH 03/23] Link to files, in re-exports as well. --- R/object-import.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/object-import.R b/R/object-import.R index b3f0a8ceb..7a3514c87 100644 --- a/R/object-import.R +++ b/R/object-import.R @@ -19,7 +19,12 @@ merge.rd_section_reexport <- function(x, y, ...) { format.rd_section_reexport <- function(x, ...) { pkgs <- split(x$value$fun, x$value$pkg) pkg_links <- map2(names(pkgs), pkgs, function(pkg, funs) { - links <- paste0("\\code{\\link[", pkg, "]{", escape(sort(funs)), "}}", + funs <- sort(funs) + files <- vapply(funs, find_topic_filename, character(1), pkg = pkg) + links <- paste0( + "\\code{\\link[", pkg, + ifelse(files == funs, "", paste0(":", files)), + "]{", escape(funs), "}}", collapse = ", ") paste0("\\item{", pkg, "}{", links, "}") }) From b533014d1ade8359e9cd66ce9b408516471cdd56 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 12 Jun 2020 08:17:47 +0100 Subject: [PATCH 04/23] Use dev rmarkdown, to work around a bug in the CRAN version https://github.com/rstudio/rmarkdown/issues/1831 --- .github/workflows/R-CMD-check.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index e639ee755..c28c9390a 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -67,6 +67,7 @@ jobs: run: | remotes::install_deps(dependencies = TRUE) remotes::install_cran("rcmdcheck") + remotes::install_github("rstudio/rmarkdown") shell: Rscript {0} - name: Check From adb089d3c10466048f3dd427eedbe584f643864a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 12 Jun 2020 12:21:19 +0100 Subject: [PATCH 05/23] Do not link to file, if not needed I.e. if the name of the topic is the same as the name of the file, then we are ok. --- R/markdown-link.R | 3 ++- R/object-import.R | 3 ++- R/topic.R | 18 +++++------------ R/utils.R | 48 ++++++++++++++++++++++++++++++++++++-------- man/RoxyTopic.Rd | 10 ++++----- man/load_options.Rd | 2 +- man/markdown-test.Rd | 2 +- man/roclet.Rd | 2 +- man/roxy_block.Rd | 2 +- man/roxy_tag.Rd | 2 +- man/roxy_tag_rd.Rd | 2 +- man/roxygenize.Rd | 4 ++-- man/tag_parsers.Rd | 4 ++-- 13 files changed, 64 insertions(+), 38 deletions(-) diff --git a/R/markdown-link.R b/R/markdown-link.R index 72f0c652c..94b546187 100644 --- a/R/markdown-link.R +++ b/R/markdown-link.R @@ -128,7 +128,8 @@ parse_link <- function(destination, contents, state) { obj <- sub("[(][)]$", "", fun) s4 <- str_detect(destination, "-class$") noclass <- str_match(fun, "^(.*)-class$")[1,2] - file <- find_topic_filename(pkg, obj) + force_file_name <- has_link_text || is_fun || !is.na(pkg) + file <- find_topic_filename(pkg, obj, state$tag, force_file_name) ## To understand this, look at the RD column of the table above if (!has_link_text) { diff --git a/R/object-import.R b/R/object-import.R index 7a3514c87..6768d28e6 100644 --- a/R/object-import.R +++ b/R/object-import.R @@ -20,7 +20,8 @@ format.rd_section_reexport <- function(x, ...) { pkgs <- split(x$value$fun, x$value$pkg) pkg_links <- map2(names(pkgs), pkgs, function(pkg, funs) { funs <- sort(funs) - files <- vapply(funs, find_topic_filename, character(1), pkg = pkg) + # TODO: warn for unknown package or topic + files <- vapply(funs, find_topic_in_package, character(1), pkg = pkg) links <- paste0( "\\code{\\link[", pkg, ifelse(files == funs, "", paste0(":", files)), diff --git a/R/topic.R b/R/topic.R index 2df41a766..893d344ae 100644 --- a/R/topic.R +++ b/R/topic.R @@ -47,19 +47,11 @@ RoxyTopic <- R6::R6Class("RoxyTopic", public = list( if (!is.null(self$linkmap)) { id <- roxy_meta_get("link_id") - idlen <- nchar(id) - fixer <- function(str) { - topic <- substr(str, idlen + 1, nchar(str) - idlen) - filename <- self$linkmap[[topic]] - if (length(filename) == 0) { - roxy_warning( - "Link to unknown topic '", topic, "' in file '", self$filename, "'" - ) - filename <- topic - } - filename[1] - } - rd <- str_replace_all(rd, regex(paste0(id, "(.*?)", id)), fixer) + rd <- str_replace_all( + rd, + regex(paste0("(\\[=)?", id, "(.*?)", id, "(\\])?")), + function(str) fix_link_to_file(str, self$linkmap) + ) } rd diff --git a/R/utils.R b/R/utils.R index ad3e2c4ea..3d90e60f1 100644 --- a/R/utils.R +++ b/R/utils.R @@ -161,25 +161,33 @@ uuid <- function(nchar = 8) { ) } -find_topic_filename <- function(pkg, topic) { +find_topic_in_package <- function(pkg, topic) { + raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) + basename(utils::help((raw_topic), (pkg))[1]) +} + +find_topic_filename <- function(pkg, topic, tag, force = TRUE) { # This is needed because we have the escaped text here, and parse_Rd will # un-escape it properly. - # TODO: include file name and line number here as well - raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { id <- roxy_meta_get("link_id") - paste0(id, topic, id) + if (!is.null(id)) { + # id is only NULL in test cases, not in roxygenize() + file <- URLencode(basename(tag$file), TRUE, TRUE) + paste0(id, ",", force + 0, ",", file, ",", tag$line, ",", topic, ",", id) + } else { + topic + } } else { - # TODO: include file names and line numbers in warning messages path <- tryCatch( - basename(utils::help((raw_topic), (pkg))[1]), + find_topic_in_package(pkg, topic), error = function(err) { - roxy_warning("Link to unavailable package: ", pkg, ". ", err$message) + roxy_tag_warning(tag, "Link to unavailable package: ", pkg, ". ", err$message) topic } ) if (is.na(path)) { - roxy_warning("Link to unknown topic: ", topic, " in package ", pkg) + roxy_tag_warning(tag, "Link to unknown topic: ", topic, " in package ", pkg) topic } else { path @@ -187,6 +195,30 @@ find_topic_filename <- function(pkg, topic) { } } +fix_link_to_file <- function(str, linkmap) { + id <- roxy_meta_get("link_id") + idlen <- nchar(id) + nopkg <- FALSE + if (substr(str, 1, 1) == "[") { + nopkg <- TRUE + str <- substr(str, 3, nchar(str) - 1) + } + pieces <- strsplit(str, ",", fixed = TRUE)[[1]] + topic <- pieces[5] + filename <- linkmap[[topic]] + if (length(filename) == 0) { + # TODO: show original file name and line number + roxy_warning("Link to unknown topic '", topic, "'") + filename <- topic + } + # Do we need an explicit file name at all? + if (filename[1] == topic && nopkg && pieces[2] == "0") { + "" + } else { + paste0("[=", filename[1], "]") + } +} + # quoting ----------------------------------------------------------------- auto_backtick <- function(x) { needs_backtick <- !has_quotes(x) & !is_syntactic(x) diff --git a/man/RoxyTopic.Rd b/man/RoxyTopic.Rd index 560a8ab9c..4718fa857 100644 --- a/man/RoxyTopic.Rd +++ b/man/RoxyTopic.Rd @@ -109,7 +109,7 @@ Query a section. \if{html}{\out{
}} } \subsection{Returns}{ -The \link[=rd_section]{rd_section} object representing the section, or \code{NULL} +The \link{rd_section} object representing the section, or \code{NULL} if the topic has no such section. } } @@ -118,7 +118,7 @@ if the topic has no such section. \if{latex}{\out{\hypertarget{method-get_value}{}}} \subsection{Method \code{get_value()}}{ Query the value of a section. This is the value of -the \link[=rd_section]{rd_section} object. +the \link{rd_section} object. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RoxyTopic$get_value(type)}\if{html}{\out{
}} } @@ -215,8 +215,8 @@ Add one or more sections to the topic. \describe{ \item{\code{x}}{Section(s) to add. It may be another \code{RoxyTopic} object, all of its sections will be added; -or an \link[=rd_section]{rd_section} object; -or a list of \link[=rd_section]{rd_section} objects to add.} +or an \link{rd_section} object; +or a list of \link{rd_section} objects to add.} \item{\code{overwrite}}{Whether to overwrite an existing section. If \code{FALSE} then the two sections will be merged.} @@ -236,7 +236,7 @@ Add a section. \subsection{Arguments}{ \if{html}{\out{
}} \describe{ -\item{\code{section}}{\link[=rd_section]{rd_section} object to add.} +\item{\code{section}}{\link{rd_section} object to add.} \item{\code{overwrite}}{Whether to overwrite an existing section. If \code{FALSE} then the two sections will be merged.} diff --git a/man/load_options.Rd b/man/load_options.Rd index 63924c4fa..b0bf1c1cc 100644 --- a/man/load_options.Rd +++ b/man/load_options.Rd @@ -26,7 +26,7 @@ Options in \code{man/roxygen/meta.R} override those present in \code{DESCRIPTION \item \code{roclets} \verb{}: giving names of roclets to run. See \code{\link[=roclet_find]{roclet_find()}} for details. \item \code{packages} \verb{}: packages to load that implement new tags. -\item \code{load} \verb{}: how to load R code. See \link[=load]{load} for details. +\item \code{load} \verb{}: how to load R code. See \link{load} for details. \item \code{old_usage} \verb{}: use old style usage formatting? \item \code{markdown} \verb{}: translate markdown syntax to Rd? \item \code{r6} \verb{}: document R6 classes? diff --git a/man/markdown-test.Rd b/man/markdown-test.Rd index da81e779f..a25f15278 100644 --- a/man/markdown-test.Rd +++ b/man/markdown-test.Rd @@ -6,7 +6,7 @@ \description{ Links are very tricky, so I'll put in some links here: Link to a function: \code{\link[=roxygenize]{roxygenize()}}. -Link to an object: \link[=roxygenize]{roxygenize} (we just treat it like an object here. +Link to an object: \link{roxygenize} (we just treat it like an object here. } \details{ Link to another package, function: \code{\link[devtools:document]{devtools::document()}}. diff --git a/man/roclet.Rd b/man/roclet.Rd index 520a3e282..3a4cce1e6 100644 --- a/man/roclet.Rd +++ b/man/roclet.Rd @@ -24,7 +24,7 @@ roclet_tags(x) \arguments{ \item{x}{A \code{roclet} object.} -\item{blocks}{A list of \link[=roxy_block]{roxy_block} objects.} +\item{blocks}{A list of \link{roxy_block} objects.} \item{base_path}{Path to root of source package.} diff --git a/man/roxy_block.Rd b/man/roxy_block.Rd index cad16c3dd..96ded7572 100644 --- a/man/roxy_block.Rd +++ b/man/roxy_block.Rd @@ -19,7 +19,7 @@ block_get_tag(block, tag) block_get_tag_value(block, tag) } \arguments{ -\item{tags}{A list of \link[=roxy_tag]{roxy_tag}s.} +\item{tags}{A list of \link{roxy_tag}s.} \item{file, line}{Location of the \code{call} (i.e. the line after the last line of the block).} diff --git a/man/roxy_tag.Rd b/man/roxy_tag.Rd index b4570ffed..32ae1a8c1 100644 --- a/man/roxy_tag.Rd +++ b/man/roxy_tag.Rd @@ -31,7 +31,7 @@ a list. Usually filled in by \code{tag_parsers}} } \section{Methods}{ -Define a method for \code{roxy_tag_parse} to support new tags. See \link[=tag_parsers]{tag_parsers} +Define a method for \code{roxy_tag_parse} to support new tags. See \link{tag_parsers} for more details. } diff --git a/man/roxy_tag_rd.Rd b/man/roxy_tag_rd.Rd index 41ae8328f..c708a3905 100644 --- a/man/roxy_tag_rd.Rd +++ b/man/roxy_tag_rd.Rd @@ -14,7 +14,7 @@ roxy_tag_rd(x, base_path, env) \item{env}{Environment in which to evaluate code (if needed)} } \value{ -Methods must return a \link[=rd_section]{rd_section}. +Methods must return a \link{rd_section}. } \description{ Provide a method for this generic if you want a tag to generate output diff --git a/man/roxygenize.Rd b/man/roxygenize.Rd index ff5dddf6f..fd1b064c1 100644 --- a/man/roxygenize.Rd +++ b/man/roxygenize.Rd @@ -20,7 +20,7 @@ which defaults to \code{c("collate", "namespace", "rd")}.} \item{load_code}{A function used to load all the R code in the package directory. The default, \code{NULL}, uses the strategy defined by the \code{load} roxygen option, which defaults to \code{\link[=load]{load_pkgload()}}. -See \link[=load]{load} for more details.} +See \link{load} for more details.} \item{clean}{If \code{TRUE}, roxygen will delete all files previously created by roxygen before running each roclet.} @@ -38,6 +38,6 @@ for more details. \details{ Note that roxygen2 is a dynamic documentation system: it works by inspecting loaded objects in the package. This means that you must -be able to load the package in order to document it: see \link[=load]{load} for +be able to load the package in order to document it: see \link{load} for details. } diff --git a/man/tag_parsers.Rd b/man/tag_parsers.Rd index 5389341dd..a5a425394 100644 --- a/man/tag_parsers.Rd +++ b/man/tag_parsers.Rd @@ -41,7 +41,7 @@ tag_markdown(x) tag_markdown_with_sections(x) } \arguments{ -\item{x}{A \link[=roxy_tag]{roxy_tag} object to parse} +\item{x}{A \link{roxy_tag} object to parse} \item{first, second}{Name of first and second parts of two part tags} @@ -53,7 +53,7 @@ tag_markdown_with_sections(x) \item{min, max}{Minimum and maximum number of words} } \value{ -A \link[=roxy_tag]{roxy_tag} object with the \code{val} field set to the parsed value. +A \link{roxy_tag} object with the \code{val} field set to the parsed value. } \description{ These functions parse the \code{raw} tag value, convert a string into a richer R From a86e14c33cf359deccdc28155724966f67871889 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 12 Jun 2020 14:36:00 +0100 Subject: [PATCH 06/23] Link to files refactoring Also implement proper warnings, with file names and line numbers, for re-exports as well. --- R/object-import.R | 19 +++++++++-- R/rd-postprocess-links.R | 70 ++++++++++++++++++++++++++++++++++++++++ R/topic.R | 7 +--- R/utils.R | 58 --------------------------------- 4 files changed, 88 insertions(+), 66 deletions(-) create mode 100644 R/rd-postprocess-links.R diff --git a/R/object-import.R b/R/object-import.R index 6768d28e6..e1e97b1f8 100644 --- a/R/object-import.R +++ b/R/object-import.R @@ -20,8 +20,7 @@ format.rd_section_reexport <- function(x, ...) { pkgs <- split(x$value$fun, x$value$pkg) pkg_links <- map2(names(pkgs), pkgs, function(pkg, funs) { funs <- sort(funs) - # TODO: warn for unknown package or topic - files <- vapply(funs, find_topic_in_package, character(1), pkg = pkg) + files <- vapply(funs, find_topic_in_package_reexp, character(1), pkg = pkg) links <- paste0( "\\code{\\link[", pkg, ifelse(files == funs, "", paste0(":", files)), @@ -40,3 +39,19 @@ format.rd_section_reexport <- function(x, ...) { "\n}}\n" ) } + +find_topic_in_package_reexp <- function(pkg, topic) { + path <- tryCatch( + find_topic_in_package(pkg, topic), + error = function(err) { + roxy_warning("Unavailable package in re-export: ", pkg, "::", topic) + topic + } + ) + if (is.na(path)) { + roxy_warning("Unavailable topic in re-export: ", pkg, "::", topic) + topic + } else { + path + } +} diff --git a/R/rd-postprocess-links.R b/R/rd-postprocess-links.R new file mode 100644 index 000000000..2f214bb77 --- /dev/null +++ b/R/rd-postprocess-links.R @@ -0,0 +1,70 @@ + +find_topic_in_package <- function(pkg, topic) { + # This is needed because we have the escaped text here, and parse_Rd will + # un-escape it properly. + raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) + basename(utils::help((raw_topic), (pkg))[1]) +} + +find_topic_filename <- function(pkg, topic, tag, force = TRUE) { + if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { + id <- roxy_meta_get("link_id") + if (!is.null(id)) { + # id is only NULL in test cases, not in roxygenize() + file <- URLencode(basename(tag$file), TRUE, TRUE) + paste0(id, ",", force + 0, ",", file, ",", tag$line, ",", topic, ",", id) + } else { + topic + } + } else { + path <- tryCatch( + find_topic_in_package(pkg, topic), + error = function(err) { + roxy_tag_warning(tag, "Link to unavailable package: ", pkg, ". ", err$message) + topic + } + ) + if (is.na(path)) { + roxy_tag_warning(tag, "Link to unknown topic: ", topic, " in package ", pkg) + topic + } else { + path + } + } +} + +fix_links_to_file <- function(rd, linkmap) { + id <- roxy_meta_get("link_id") + # This can only be NULL in our test cases + if (is.null(id)) return(rd) + + fix_link_to_file <- function(str, linkmap) { + nopkg <- FALSE + if (substr(str, 1, 1) == "[") { + nopkg <- TRUE + str <- substr(str, 3, nchar(str) - 1) + } + pieces <- strsplit(str, ",", fixed = TRUE)[[1]] + topic <- pieces[5] + filename <- linkmap[[topic]] + if (length(filename) == 0) { + roxy_warning( + "Link to unknown topic '", topic, "'", + file = utils::URLdecode(pieces[3]), + line = as.integer(pieces[4]) + ) + filename <- topic + } + if (filename[1] == topic && nopkg && pieces[2] == "0") { + "" + } else { + paste0("[=", filename[1], "]") + } + } + + str_replace_all( + rd, + regex(paste0("(\\[=)?", id, "(.*?)", id, "(\\])?")), + function(str) fix_link_to_file(str, linkmap) + ) +} diff --git a/R/topic.R b/R/topic.R index 893d344ae..874c86416 100644 --- a/R/topic.R +++ b/R/topic.R @@ -46,12 +46,7 @@ RoxyTopic <- R6::R6Class("RoxyTopic", public = list( ) if (!is.null(self$linkmap)) { - id <- roxy_meta_get("link_id") - rd <- str_replace_all( - rd, - regex(paste0("(\\[=)?", id, "(.*?)", id, "(\\])?")), - function(str) fix_link_to_file(str, self$linkmap) - ) + rd <- fix_links_to_file(rd, self$linkmap) } rd diff --git a/R/utils.R b/R/utils.R index 3d90e60f1..9251717c4 100644 --- a/R/utils.R +++ b/R/utils.R @@ -161,64 +161,6 @@ uuid <- function(nchar = 8) { ) } -find_topic_in_package <- function(pkg, topic) { - raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) - basename(utils::help((raw_topic), (pkg))[1]) -} - -find_topic_filename <- function(pkg, topic, tag, force = TRUE) { - # This is needed because we have the escaped text here, and parse_Rd will - # un-escape it properly. - if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { - id <- roxy_meta_get("link_id") - if (!is.null(id)) { - # id is only NULL in test cases, not in roxygenize() - file <- URLencode(basename(tag$file), TRUE, TRUE) - paste0(id, ",", force + 0, ",", file, ",", tag$line, ",", topic, ",", id) - } else { - topic - } - } else { - path <- tryCatch( - find_topic_in_package(pkg, topic), - error = function(err) { - roxy_tag_warning(tag, "Link to unavailable package: ", pkg, ". ", err$message) - topic - } - ) - if (is.na(path)) { - roxy_tag_warning(tag, "Link to unknown topic: ", topic, " in package ", pkg) - topic - } else { - path - } - } -} - -fix_link_to_file <- function(str, linkmap) { - id <- roxy_meta_get("link_id") - idlen <- nchar(id) - nopkg <- FALSE - if (substr(str, 1, 1) == "[") { - nopkg <- TRUE - str <- substr(str, 3, nchar(str) - 1) - } - pieces <- strsplit(str, ",", fixed = TRUE)[[1]] - topic <- pieces[5] - filename <- linkmap[[topic]] - if (length(filename) == 0) { - # TODO: show original file name and line number - roxy_warning("Link to unknown topic '", topic, "'") - filename <- topic - } - # Do we need an explicit file name at all? - if (filename[1] == topic && nopkg && pieces[2] == "0") { - "" - } else { - paste0("[=", filename[1], "]") - } -} - # quoting ----------------------------------------------------------------- auto_backtick <- function(x) { needs_backtick <- !has_quotes(x) & !is_syntactic(x) From 66f00cd963aca03152cb62bf6ab33f1219b85405 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Fri, 12 Jun 2020 16:26:36 +0100 Subject: [PATCH 07/23] Add test to auto-linking to file --- R/markdown-link.R | 7 +++++++ man/markdown-test.Rd | 7 +++++++ 2 files changed, 14 insertions(+) diff --git a/R/markdown-link.R b/R/markdown-link.R index 94b546187..017f79f29 100644 --- a/R/markdown-link.R +++ b/R/markdown-link.R @@ -179,6 +179,13 @@ parse_link <- function(destination, contents, state) { #' #' In another package: [and this one][devtools::document]. #' +#' Can we link to another package, without specifying which one? +#' E.g. [str_replace()]. Or to a non-function topic: [str_replace]. +#' This is the correct filename, so all is good. +#' +#' This one is not the correct filename, so we'll need to remove it before +#' CRAN submission: [str_replace_all()] and [str_replace_all]. +#' #' This is a table: #' #' | __foo__ | __bar__ | diff --git a/man/markdown-test.Rd b/man/markdown-test.Rd index a25f15278..1bf1ed1e4 100644 --- a/man/markdown-test.Rd +++ b/man/markdown-test.Rd @@ -17,6 +17,13 @@ Link with link text: \link[=roxygenize]{this great function}, In another package: \link[devtools:document]{and this one}. +Can we link to another package, without specifying which one? +E.g. \code{\link[=str_replace]{str_replace()}}. Or to a non-function topic: \link{str_replace}. +This is the correct filename, so all is good. + +This one is not the correct filename, so we'll need to remove it before +CRAN submission: \code{\link[=str_replace_all]{str_replace_all()}} and \link{str_replace_all}. + This is a table:\tabular{lr}{ \strong{foo} \tab \strong{bar} \cr 1 \tab 2 \cr From 683941f4407e34b7c21536ed8fdb844632c36175 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Sat, 13 Jun 2020 08:21:47 +0100 Subject: [PATCH 08/23] Fix qualified links to the dev package --- R/rd-postprocess-links.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/rd-postprocess-links.R b/R/rd-postprocess-links.R index 2f214bb77..371f94428 100644 --- a/R/rd-postprocess-links.R +++ b/R/rd-postprocess-links.R @@ -57,8 +57,10 @@ fix_links_to_file <- function(rd, linkmap) { } if (filename[1] == topic && nopkg && pieces[2] == "0") { "" - } else { + } else if (nopkg) { paste0("[=", filename[1], "]") + } else { + filename[1] } } From fe7dda7c97174c0990381b2cece310e31783626b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Sat, 13 Jun 2020 09:38:06 +0100 Subject: [PATCH 09/23] Add dev docs for linking to file names --- R/rd-postprocess-links.R | 103 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 97 insertions(+), 6 deletions(-) diff --git a/R/rd-postprocess-links.R b/R/rd-postprocess-links.R index 371f94428..1801f0149 100644 --- a/R/rd-postprocess-links.R +++ b/R/rd-postprocess-links.R @@ -1,10 +1,61 @@ -find_topic_in_package <- function(pkg, topic) { - # This is needed because we have the escaped text here, and parse_Rd will - # un-escape it properly. - raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) - basename(utils::help((raw_topic), (pkg))[1]) -} +#' Find the Rd file of a topic, or generate a placeholder string, to fill in +#' later +#' +#' @param pkg Package to search in, or `NA` if no package was specified. +#' If the same as the dev package, then we treat it as `NA`. +#' @param topic Topic to search for. This is the escaped, so it is `"\%\%"` and +#' not `"%%"`. +#' @param tag The roxy tag object that contains the link. We use this for +#' better warnings, that include the file name and line number (of the tag). +#' @param force Whether we must always include a file name, even if it matches +#' the topic. See more below. +#' @return String. File name or placeholder. See details below. +#' +#' @details +#' If `pkg` is not `NA` and not the package being documented (the _dev_ +#' package), then we need to be able to find the Rd file. If we can't, that's +#' a warning and the link is left untouched. This typically happens when the +#' linked package is not installed or cannot be loaded. +#' +#' If `pkg` is `NA` that means that the link is unqualified (only the topic is +#' given, its package is not). This typically means a link to the dev package, +#' but not necessarily, given that [utils::help()] is able to look up topics +#' at render time. +#' +#' If `pkg` is not specified then we cannot yet find the Rd file name of the +#' link. In this case we return a placeholder string, that is finalized when +#' the Rd content is created, in the [RoxyTopic] `format()` method, by a +#' call to `fix_links_to_file()` below. +#' +#' The placeholder string looks like this: +#' ``` +#' id|force|file|line|topic|id +#' ``` +#' +#' * `id`: is a random id that is used to find the links that need +#' post-processing. It is generated at the beginning of `roxygenize()`, so +#' it is the same for all placeholders. We use a single id, so we don't +#' need to keep a dictionary of placeholders and multiple searches. A +#' single regular expression search finds all placeholders of an Rd file, +#' see `fix_links_to_file()` below. +#' * `force`: is whether we always need to include a file name. If the link +#' text is different from the topic name (e.g. most commonly because we are +#' linking to a function and adding `()`), then this is set to `"1"`. +#' Otherwise it is set to `"0"`. If it is `"0"`, and we can get away without +#' including a file name. +#' * `file`: R file name of the link. Can be used for better warnings. To allow +#' arbitrary file names without throwing off our regex search, this is +#' URL encoded. +#' * `line`: Line number of the link. Can be used for better warnings. +#' It seems that this is the line number of the roxygen2 tag, within the +#' roxygen2 block, which is not great, but we can improve it later. +#' * `topic`: the topic we are linking to, that needs to be mapped to a +#' file name. Escaped, so it will be `\%\%`, and not `%%`. +#' * `id`: the same random id again, so we can easily identify the start and +#' end of the placeholder. +#' +#' @noRd find_topic_filename <- function(pkg, topic, tag, force = TRUE) { if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { @@ -33,6 +84,46 @@ find_topic_filename <- function(pkg, topic, tag, force = TRUE) { } } +#' Find a help topic in a package +#' +#' This is used by both `find_topic_filename()` and +#' `format.rd_section_reexport()` that creates the re-exports page. The error +#' messages are different for the two, so errors are not handled here. +#' +#' @param pkg Package name. This cannot be `NA`. +#' @inheritParams find_topic_filename +#' @return File name if the topic was found, `NA` if the package could be +#' searched, but the topic was not found. Errors if the package cannot be +#' searched. (Because it is not installed or cannot be loaded, etc.) +#' +#' @noRd + +find_topic_in_package <- function(pkg, topic) { + # This is needed because we have the escaped text here, and parse_Rd will + # un-escape it properly. + raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) + basename(utils::help((raw_topic), (pkg))[1]) +} + +#' Replace placeholders with file names +#' +#' @param rd The text of a manual page. +#' @param linkmap Environment that maps from topic to file name(s). One +#' topic might link to multiple file names, but we always use the first one. +#' This is a `@name` if the topic had a name at all. Otherwise it is the +#' first of the `@aliases`. +#' @return String. `rd`, with the link placeholders filled in. +#' +#' @details +#' TODO: Currently we give a warning for each topic that we cannot find, +#' but we'll change this to a single note. +#' +#' The workhorse is the `fix_link_to_file()` function, that receives the +#' text of the placeholder, usually with the surrounding `[=` ... `]` symbols. +#' (If these are not present, that's a qualified self link to the dev package.) +#' +#' @noRd + fix_links_to_file <- function(rd, linkmap) { id <- roxy_meta_get("link_id") # This can only be NULL in our test cases From 873f8ccce663fbaf0c6f8504f8cb36d76f816813 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Sat, 13 Jun 2020 21:55:26 +0100 Subject: [PATCH 10/23] Do not warn for unknown links This is R CMD check's job. --- R/markdown-link.R | 3 --- R/rd-postprocess-links.R | 9 +-------- man/markdown-test.Rd | 3 --- 3 files changed, 1 insertion(+), 14 deletions(-) diff --git a/R/markdown-link.R b/R/markdown-link.R index 017f79f29..7d405ff44 100644 --- a/R/markdown-link.R +++ b/R/markdown-link.R @@ -183,9 +183,6 @@ parse_link <- function(destination, contents, state) { #' E.g. [str_replace()]. Or to a non-function topic: [str_replace]. #' This is the correct filename, so all is good. #' -#' This one is not the correct filename, so we'll need to remove it before -#' CRAN submission: [str_replace_all()] and [str_replace_all]. -#' #' This is a table: #' #' | __foo__ | __bar__ | diff --git a/R/rd-postprocess-links.R b/R/rd-postprocess-links.R index 1801f0149..5358c92fe 100644 --- a/R/rd-postprocess-links.R +++ b/R/rd-postprocess-links.R @@ -115,9 +115,6 @@ find_topic_in_package <- function(pkg, topic) { #' @return String. `rd`, with the link placeholders filled in. #' #' @details -#' TODO: Currently we give a warning for each topic that we cannot find, -#' but we'll change this to a single note. -#' #' The workhorse is the `fix_link_to_file()` function, that receives the #' text of the placeholder, usually with the surrounding `[=` ... `]` symbols. #' (If these are not present, that's a qualified self link to the dev package.) @@ -139,11 +136,7 @@ fix_links_to_file <- function(rd, linkmap) { topic <- pieces[5] filename <- linkmap[[topic]] if (length(filename) == 0) { - roxy_warning( - "Link to unknown topic '", topic, "'", - file = utils::URLdecode(pieces[3]), - line = as.integer(pieces[4]) - ) + # If we were to warn about this, this is the place filename <- topic } if (filename[1] == topic && nopkg && pieces[2] == "0") { diff --git a/man/markdown-test.Rd b/man/markdown-test.Rd index 1bf1ed1e4..31231af7b 100644 --- a/man/markdown-test.Rd +++ b/man/markdown-test.Rd @@ -21,9 +21,6 @@ Can we link to another package, without specifying which one? E.g. \code{\link[=str_replace]{str_replace()}}. Or to a non-function topic: \link{str_replace}. This is the correct filename, so all is good. -This one is not the correct filename, so we'll need to remove it before -CRAN submission: \code{\link[=str_replace_all]{str_replace_all()}} and \link{str_replace_all}. - This is a table:\tabular{lr}{ \strong{foo} \tab \strong{bar} \cr 1 \tab 2 \cr From 8819f9ac052cf4168676a1961053308ebbab19df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Sun, 14 Jun 2020 00:28:42 +0100 Subject: [PATCH 11/23] Link to file for cross-package qualified links But leave the rest of the links alone. --- R/markdown-link.R | 31 +++--- R/object-s3.R | 2 +- R/rd-find-link-files.R | 63 +++++++++++ R/rd-postprocess-links.R | 156 ---------------------------- R/rd.R | 1 - R/roxygenize.R | 2 - R/topic.R | 12 +-- R/topics.R | 17 --- man/RoxyTopic.Rd | 3 - man/is_s3_generic.Rd | 2 +- man/markdown-test.Rd | 4 - man/markdown_pass1.Rd | 3 +- man/roclet.Rd | 2 +- man/roxygenize.Rd | 2 +- tests/testthat/test-markdown-link.R | 33 +++--- 15 files changed, 100 insertions(+), 233 deletions(-) create mode 100644 R/rd-find-link-files.R delete mode 100644 R/rd-postprocess-links.R diff --git a/R/markdown-link.R b/R/markdown-link.R index 7d405ff44..a359bcf42 100644 --- a/R/markdown-link.R +++ b/R/markdown-link.R @@ -4,25 +4,23 @@ #' spaces between the closing and opening bracket in the `[text][ref]` #' form. #' -#' Starting from R 4.0.2-ish, links to topics are not allowed, so for each -#' linked topic, we look up the linked file and check if the file name is the -#' same as the topic name, and generate the longer form for `[obj]` style -#' links. +#' Starting from R 4.0.2-ish, explicit cross-package links to topics are not +#' allowed, so for each such linked topic, we look up the linked file. #' #' These are the link references we add: #' ``` #' MARKDOWN LINK TEXT CODE RD #' -------- --------- ---- -- -#' [fun()] fun() T \\link[=file]{fun()} -#' [obj] obj F \\link{obj} or \\link[=file]{obj} +#' [fun()] fun() T \\link[=fun]{fun()} +#' [obj] obj F \\link{obj} #' [pkg::fun()] pkg::fun() T \\link[pkg:file]{pkg::fun()} #' [pkg::obj] pkg::obj F \\link[pkg:file]{pkg::obj} -#' [text][fun()] text F \\link[=file]{text} -#' [text][obj] text F \\link[=file]{text} +#' [text][fun()] text F \\link[=fun]{text} +#' [text][obj] text F \\link[=obj]{text} #' [text][pkg::fun()] text F \\link[pkg:file]{text} #' [text][pkg::obj] text F \\link[pkg:file]{text} #' [s4-class] s4 F \\linkS4class{s4} -#' [pkg::s4-class] pkg::s4 F \\link[pkg:s4-class]{pkg::s4} +#' [pkg::s4-class] pkg::s4 F \\link[pkg:file]{pkg::s4} #' ``` #' #' The reference links will always look like `R:ref` for `[ref]` and @@ -128,18 +126,17 @@ parse_link <- function(destination, contents, state) { obj <- sub("[(][)]$", "", fun) s4 <- str_detect(destination, "-class$") noclass <- str_match(fun, "^(.*)-class$")[1,2] - force_file_name <- has_link_text || is_fun || !is.na(pkg) - file <- find_topic_filename(pkg, obj, state$tag, force_file_name) + file <- find_topic_filename(pkg, obj, state$tag) ## To understand this, look at the RD column of the table above if (!has_link_text) { paste0( if (is_code) "\\code{", if (s4 && is.na(pkg)) "\\linkS4class" else "\\link", - if (is_fun || ! is.na(pkg) || file != obj) "[", - if ((is_fun || file != obj) && is.na(pkg)) "=", + if (is_fun || ! is.na(pkg)) "[", + if (is_fun && is.na(pkg)) "=", if (! is.na(pkg)) paste0(pkg, ":"), - if (is_fun || ! is.na(pkg) || file != obj) paste0(file, "]"), + if (is_fun || ! is.na(pkg)) paste0(if (is.na(pkg)) obj else file, "]"), "{", if (!is.na(pkg)) paste0(pkg, "::"), if (s4) noclass else fun, @@ -155,7 +152,7 @@ parse_link <- function(destination, contents, state) { if (is_code) "\\code{", "\\link[", if (is.na(pkg)) "=" else paste0(pkg, ":"), - file, + if (is.na(pkg)) obj else file, "]{" ), contents, @@ -179,10 +176,6 @@ parse_link <- function(destination, contents, state) { #' #' In another package: [and this one][devtools::document]. #' -#' Can we link to another package, without specifying which one? -#' E.g. [str_replace()]. Or to a non-function topic: [str_replace]. -#' This is the correct filename, so all is good. -#' #' This is a table: #' #' | __foo__ | __bar__ | diff --git a/R/object-s3.R b/R/object-s3.R index 08608a350..1c4b944a5 100644 --- a/R/object-s3.R +++ b/R/object-s3.R @@ -3,7 +3,7 @@ #' @description #' `is_s3_generic` compares name to `.knownS3Generics` and #' `.S3PrimitiveGenerics`, then looks at the function body to see if it -#' calls [base::UseMethod()]. +#' calls [UseMethod()]. #' #' `is_s3_method` builds names of all possible generics for that function #' and then checks if any of them actually is a generic. diff --git a/R/rd-find-link-files.R b/R/rd-find-link-files.R new file mode 100644 index 000000000..12a0e16ae --- /dev/null +++ b/R/rd-find-link-files.R @@ -0,0 +1,63 @@ + +#' Find the Rd file of a topic +#' +#' @param pkg Package to search in, or `NA` if no package was specified. +#' If the same as the dev package, then we treat it as `NA`. +#' @param topic Topic to search for. This is the escaped, so it is `"\%\%"` and +#' not `"%%"`. +#' @param tag The roxy tag object that contains the link. We use this for +#' better warnings, that include the file name and line number (of the tag). +#' @return String. File name to link to. +#' +#' @details +#' If `pkg` is `NA` or the package being documented, we'll just leave the +#' topic alone. +#' +#' If `pkg` is not `NA` and not the package being documented (the _dev_ +#' package), then we need to be able to find the Rd file. If we can't, that's +#' a warning and the link is left untouched. This typically happens when the +#' linked package is not installed or cannot be loaded. +#' +#' @noRd + +find_topic_filename <- function(pkg, topic, tag) { + tag <- tag %||% list(file = NA, line = NA) + if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { + topic + } else { + path <- tryCatch( + find_topic_in_package(pkg, topic), + error = function(err) { + roxy_tag_warning(tag, "Link to unavailable package: ", pkg, ". ", err$message) + topic + } + ) + if (is.na(path)) { + roxy_tag_warning(tag, "Link to unknown topic: ", topic, " in package ", pkg) + topic + } else { + path + } + } +} + +#' Find a help topic in a package +#' +#' This is used by both `find_topic_filename()` and +#' `format.rd_section_reexport()` that creates the re-exports page. The error +#' messages are different for the two, so errors are not handled here. +#' +#' @param pkg Package name. This cannot be `NA`. +#' @inheritParams find_topic_filename +#' @return File name if the topic was found, `NA` if the package could be +#' searched, but the topic was not found. Errors if the package cannot be +#' searched. (Because it is not installed or cannot be loaded, etc.) +#' +#' @noRd + +find_topic_in_package <- function(pkg, topic) { + # This is needed because we have the escaped text here, and parse_Rd will + # un-escape it properly. + raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) + basename(utils::help((raw_topic), (pkg))[1]) +} diff --git a/R/rd-postprocess-links.R b/R/rd-postprocess-links.R deleted file mode 100644 index 5358c92fe..000000000 --- a/R/rd-postprocess-links.R +++ /dev/null @@ -1,156 +0,0 @@ - -#' Find the Rd file of a topic, or generate a placeholder string, to fill in -#' later -#' -#' @param pkg Package to search in, or `NA` if no package was specified. -#' If the same as the dev package, then we treat it as `NA`. -#' @param topic Topic to search for. This is the escaped, so it is `"\%\%"` and -#' not `"%%"`. -#' @param tag The roxy tag object that contains the link. We use this for -#' better warnings, that include the file name and line number (of the tag). -#' @param force Whether we must always include a file name, even if it matches -#' the topic. See more below. -#' @return String. File name or placeholder. See details below. -#' -#' @details -#' If `pkg` is not `NA` and not the package being documented (the _dev_ -#' package), then we need to be able to find the Rd file. If we can't, that's -#' a warning and the link is left untouched. This typically happens when the -#' linked package is not installed or cannot be loaded. -#' -#' If `pkg` is `NA` that means that the link is unqualified (only the topic is -#' given, its package is not). This typically means a link to the dev package, -#' but not necessarily, given that [utils::help()] is able to look up topics -#' at render time. -#' -#' If `pkg` is not specified then we cannot yet find the Rd file name of the -#' link. In this case we return a placeholder string, that is finalized when -#' the Rd content is created, in the [RoxyTopic] `format()` method, by a -#' call to `fix_links_to_file()` below. -#' -#' The placeholder string looks like this: -#' ``` -#' id|force|file|line|topic|id -#' ``` -#' -#' * `id`: is a random id that is used to find the links that need -#' post-processing. It is generated at the beginning of `roxygenize()`, so -#' it is the same for all placeholders. We use a single id, so we don't -#' need to keep a dictionary of placeholders and multiple searches. A -#' single regular expression search finds all placeholders of an Rd file, -#' see `fix_links_to_file()` below. -#' * `force`: is whether we always need to include a file name. If the link -#' text is different from the topic name (e.g. most commonly because we are -#' linking to a function and adding `()`), then this is set to `"1"`. -#' Otherwise it is set to `"0"`. If it is `"0"`, and we can get away without -#' including a file name. -#' * `file`: R file name of the link. Can be used for better warnings. To allow -#' arbitrary file names without throwing off our regex search, this is -#' URL encoded. -#' * `line`: Line number of the link. Can be used for better warnings. -#' It seems that this is the line number of the roxygen2 tag, within the -#' roxygen2 block, which is not great, but we can improve it later. -#' * `topic`: the topic we are linking to, that needs to be mapped to a -#' file name. Escaped, so it will be `\%\%`, and not `%%`. -#' * `id`: the same random id again, so we can easily identify the start and -#' end of the placeholder. -#' -#' @noRd - -find_topic_filename <- function(pkg, topic, tag, force = TRUE) { - if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { - id <- roxy_meta_get("link_id") - if (!is.null(id)) { - # id is only NULL in test cases, not in roxygenize() - file <- URLencode(basename(tag$file), TRUE, TRUE) - paste0(id, ",", force + 0, ",", file, ",", tag$line, ",", topic, ",", id) - } else { - topic - } - } else { - path <- tryCatch( - find_topic_in_package(pkg, topic), - error = function(err) { - roxy_tag_warning(tag, "Link to unavailable package: ", pkg, ". ", err$message) - topic - } - ) - if (is.na(path)) { - roxy_tag_warning(tag, "Link to unknown topic: ", topic, " in package ", pkg) - topic - } else { - path - } - } -} - -#' Find a help topic in a package -#' -#' This is used by both `find_topic_filename()` and -#' `format.rd_section_reexport()` that creates the re-exports page. The error -#' messages are different for the two, so errors are not handled here. -#' -#' @param pkg Package name. This cannot be `NA`. -#' @inheritParams find_topic_filename -#' @return File name if the topic was found, `NA` if the package could be -#' searched, but the topic was not found. Errors if the package cannot be -#' searched. (Because it is not installed or cannot be loaded, etc.) -#' -#' @noRd - -find_topic_in_package <- function(pkg, topic) { - # This is needed because we have the escaped text here, and parse_Rd will - # un-escape it properly. - raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) - basename(utils::help((raw_topic), (pkg))[1]) -} - -#' Replace placeholders with file names -#' -#' @param rd The text of a manual page. -#' @param linkmap Environment that maps from topic to file name(s). One -#' topic might link to multiple file names, but we always use the first one. -#' This is a `@name` if the topic had a name at all. Otherwise it is the -#' first of the `@aliases`. -#' @return String. `rd`, with the link placeholders filled in. -#' -#' @details -#' The workhorse is the `fix_link_to_file()` function, that receives the -#' text of the placeholder, usually with the surrounding `[=` ... `]` symbols. -#' (If these are not present, that's a qualified self link to the dev package.) -#' -#' @noRd - -fix_links_to_file <- function(rd, linkmap) { - id <- roxy_meta_get("link_id") - # This can only be NULL in our test cases - if (is.null(id)) return(rd) - - fix_link_to_file <- function(str, linkmap) { - nopkg <- FALSE - if (substr(str, 1, 1) == "[") { - nopkg <- TRUE - str <- substr(str, 3, nchar(str) - 1) - } - pieces <- strsplit(str, ",", fixed = TRUE)[[1]] - topic <- pieces[5] - filename <- linkmap[[topic]] - if (length(filename) == 0) { - # If we were to warn about this, this is the place - filename <- topic - } - if (filename[1] == topic && nopkg && pieces[2] == "0") { - "" - } else if (nopkg) { - paste0("[=", filename[1], "]") - } else { - filename[1] - } - } - - str_replace_all( - rd, - regex(paste0("(\\[=)?", id, "(.*?)", id, "(\\])?")), - function(str) fix_link_to_file(str, linkmap) - ) -} diff --git a/R/rd.R b/R/rd.R index 01f4acd24..462a1e9a2 100644 --- a/R/rd.R +++ b/R/rd.R @@ -47,7 +47,6 @@ roclet_process.roclet_rd <- function(x, blocks, env, base_path) { topics$drop_invalid() topics_fix_params_order(topics) topics_add_default_description(topics) - topics$add_linkmap() topics$topics } diff --git a/R/roxygenize.R b/R/roxygenize.R index 997334ba9..76bb1a762 100644 --- a/R/roxygenize.R +++ b/R/roxygenize.R @@ -61,9 +61,7 @@ roxygenize <- function(package.dir = ".", load_code <- find_load_strategy(load_code) env <- load_code(base_path) roxy_meta_set("env", env) - roxy_meta_set("link_id", uuid()) on.exit(roxy_meta_set("env", NULL), add = TRUE) - on.exit(roxy_meta_set("link_id", NULL), add = TRUE) # Tokenise each file blocks <- parse_package(base_path, env = NULL) diff --git a/R/topic.R b/R/topic.R index 874c86416..a50e4a3ed 100644 --- a/R/topic.R +++ b/R/topic.R @@ -19,10 +19,6 @@ RoxyTopic <- R6::R6Class("RoxyTopic", public = list( #' @field filename Path to the `.Rd` file to generate. filename = "", - #' @field linkmap Environment that maps topic names to file names, for - #' fixing links. - linkmap = NULL, - #' @description Format the `.Rd` file. It considers the sections in #' particular order, even though Rd tools will reorder them again. #' @@ -40,16 +36,10 @@ RoxyTopic <- R6::R6Class("RoxyTopic", public = list( sections <- move_names_to_front(self$sections, order) formatted <- lapply(sections, format, ...) - rd <- paste0( + paste0( made_by("%"), paste0(unlist(formatted), collapse = "\n") ) - - if (!is.null(self$linkmap)) { - rd <- fix_links_to_file(rd, self$linkmap) - } - - rd }, #' @description Check if an `.Rd` file is valid diff --git a/R/topics.R b/R/topics.R index b0b3c3418..e0d562c1c 100644 --- a/R/topics.R +++ b/R/topics.R @@ -88,23 +88,6 @@ RoxyTopics <- R6::R6Class("RoxyTopics", public = list( simple_values = function(field) { fields <- lapply(self$topics, function(rd) rd$get_section(field)) lapply(compact(fields), "[[", "value") - }, - - # Add a map from topic names to file names, this is needed for fixing the - # link targets - add_linkmap = function() { - # If no link id, then nothing to do, this only happens in tests - id <- roxy_meta_get("link_id") - if (is.null(id)) return() - - map <- new.env(parent = emptyenv()) - for (i in seq_along(self$topics)) { - self$topics[[i]]$linkmap <- map - filename <- names(self$topics)[i] - filename <- substr(filename, 1, nchar(filename) - 3) # remove .Rd - aliases <- self$topics[[i]]$get_value("alias") - for (al in aliases) map[[al]] <- c(map[[al]], filename) - } } )) diff --git a/man/RoxyTopic.Rd b/man/RoxyTopic.Rd index 4718fa857..bf4026d6a 100644 --- a/man/RoxyTopic.Rd +++ b/man/RoxyTopic.Rd @@ -14,9 +14,6 @@ A \code{RoxyTopic} object corresponds to a generated \code{.Rd} file. \code{\link[=rd_section]{rd_section()}} object.} \item{\code{filename}}{Path to the \code{.Rd} file to generate.} - -\item{\code{linkmap}}{Environment that maps topic names to file names, for -fixing links.} } \if{html}{\out{
}} } diff --git a/man/is_s3_generic.Rd b/man/is_s3_generic.Rd index e02c53bba..1fcc9955d 100644 --- a/man/is_s3_generic.Rd +++ b/man/is_s3_generic.Rd @@ -17,7 +17,7 @@ is_s3_method(name, env = parent.frame()) \description{ \code{is_s3_generic} compares name to \code{.knownS3Generics} and \code{.S3PrimitiveGenerics}, then looks at the function body to see if it -calls \code{\link[base:UseMethod]{base::UseMethod()}}. +calls \code{\link[=UseMethod]{UseMethod()}}. \code{is_s3_method} builds names of all possible generics for that function and then checks if any of them actually is a generic. diff --git a/man/markdown-test.Rd b/man/markdown-test.Rd index 31231af7b..a25f15278 100644 --- a/man/markdown-test.Rd +++ b/man/markdown-test.Rd @@ -17,10 +17,6 @@ Link with link text: \link[=roxygenize]{this great function}, In another package: \link[devtools:document]{and this one}. -Can we link to another package, without specifying which one? -E.g. \code{\link[=str_replace]{str_replace()}}. Or to a non-function topic: \link{str_replace}. -This is the correct filename, so all is good. - This is a table:\tabular{lr}{ \strong{foo} \tab \strong{bar} \cr 1 \tab 2 \cr diff --git a/man/markdown_pass1.Rd b/man/markdown_pass1.Rd index 087658e48..154611743 100644 --- a/man/markdown_pass1.Rd +++ b/man/markdown_pass1.Rd @@ -36,8 +36,7 @@ x + 1 Chunk options:\if{html}{\out{
}}\preformatted{names(mtcars) nrow(mtcars) -}\if{html}{\out{
}}\preformatted{## [1] "mpg" "cyl" "disp" "hp" "drat" "wt" "qsec" "vs" "am" "gear" -## [11] "carb" +}\if{html}{\out{}}\preformatted{## [1] "mpg" "cyl" "disp" "hp" "drat" "wt" "qsec" "vs" "am" "gear" "carb" ## [1] 32 } diff --git a/man/roclet.Rd b/man/roclet.Rd index 3a4cce1e6..66e332ffc 100644 --- a/man/roclet.Rd +++ b/man/roclet.Rd @@ -52,7 +52,7 @@ any files created by the roclet. } \subsection{Deprecated methods}{ -\code{roclet_tags()} is no longer used; instead provide a \code{\link[=roxy_tag]{roxy_tag_parse()}} +\code{roclet_tags()} is no longer used; instead provide a \code{\link[=roxy_tag_parse]{roxy_tag_parse()}} method for each tag. } } diff --git a/man/roxygenize.Rd b/man/roxygenize.Rd index fd1b064c1..0d26b2ef2 100644 --- a/man/roxygenize.Rd +++ b/man/roxygenize.Rd @@ -19,7 +19,7 @@ which defaults to \code{c("collate", "namespace", "rd")}.} \item{load_code}{A function used to load all the R code in the package directory. The default, \code{NULL}, uses the strategy defined by -the \code{load} roxygen option, which defaults to \code{\link[=load]{load_pkgload()}}. +the \code{load} roxygen option, which defaults to \code{\link[=load_pkgload]{load_pkgload()}}. See \link{load} for more details.} \item{clean}{If \code{TRUE}, roxygen will delete all files previously diff --git a/tests/testthat/test-markdown-link.R b/tests/testthat/test-markdown-link.R index 8b76352d3..5e759de60 100644 --- a/tests/testthat/test-markdown-link.R +++ b/tests/testthat/test-markdown-link.R @@ -94,16 +94,19 @@ test_that("short and sweet links work", { foo <- function() {}")[[1]] expect_equivalent_rd(out1, out2) - out1 <- roc_proc_text(rd_roclet(), " + expect_warning( + out1 <- roc_proc_text(rd_roclet(), " #' Title #' - #' See [commonmark::markdown_xml()], [commonmark::markdown_xml]. + #' See [11pkg::function()], [11pkg::object]. #' @md - foo <- function() {}")[[1]] + foo <- function() {}")[[1]], + "Link to unavailable package" + ) out2 <- roc_proc_text(rd_roclet(), " #' Title #' - #' See \\code{\\link[commonmark:commonmark]{commonmark::markdown_xml()}}, \\link[commonmark:commonmark]{commonmark::markdown_xml}. + #' See \\code{\\link[11pkg:function]{11pkg::function()}}, \\link[11pkg:object]{11pkg::object}. foo <- function() {}")[[1]] expect_equivalent_rd(out1, out2) @@ -120,16 +123,19 @@ test_that("short and sweet links work", { foo <- function() {}")[[1]] expect_equivalent_rd(out1, out2) - out1 <- roc_proc_text(rd_roclet(), " + expect_warning( + out1 <- roc_proc_text(rd_roclet(), " #' Title #' - #' Description, see [name words][commonmark::markdown_xml]. + #' Description, see [name words][stringr::bar111]. #' @md - foo <- function() {}")[[1]] + foo <- function() {}")[[1]], + "Link to unknown topic: bar111 in package stringr" + ) out2 <- roc_proc_text(rd_roclet(), " #' Title #' - #' Description, see \\link[commonmark:commonmark]{name words}. + #' Description, see \\link[stringr:bar111]{name words}. foo <- function() {}")[[1]] expect_equivalent_rd(out1, out2) @@ -243,24 +249,24 @@ test_that("another markdown link bug is fixed", { test_that("markdown code as link text is rendered as code", { - out1 <- roc_proc_text(rd_roclet(), " + suppressWarnings(out1 <- roc_proc_text(rd_roclet(), " #' Title #' #' Description, see [`name`][dest], #' [`function`][function()], #' [`filter`][stats::filter()], - #' [`bar`][stats::filter], + #' [`bar`][pkg::bar], #' [`terms`][terms.object], #' [`abc`][abc-class]. #' @md - foo <- function() {}")[[1]] + foo <- function() {}")[[1]]) out2 <- roc_proc_text(rd_roclet(), " #' Title #' #' Description, see \\code{\\link[=dest]{name}}, #' \\code{\\link[=function]{function}}, #' \\code{\\link[stats:filter]{filter}}, - #' \\code{\\link[stats:filter]{bar}}, + #' \\code{\\link[pkg:bar]{bar}}, #' \\code{\\link[=terms.object]{terms}}, #' \\code{\\link[=abc-class]{abc}}. foo <- function() {}")[[1]] @@ -366,8 +372,7 @@ test_that("links to S4 classes are OK", { foo <- function() {}")[[1]] expect_equivalent_rd(out1, out2) - # pkg::linktos4 is not a proper S4 class, so we ignore a roxy warning here - out1 <- suppressWarnings(roc_proc_text(rd_roclet(), " + suppressWarnings(out1 <- roc_proc_text(rd_roclet(), " #' Title #' #' Description, see [pkg::linktos4-class] as well. From 1e063d937de4ed3dd1656197a4f107ac28f93d07 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Sun, 14 Jun 2020 00:41:13 +0100 Subject: [PATCH 12/23] NEWS entry for linking to files --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 6ab9d9295..c419273a9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # roxygen2 (development version) +* When processing cross package markdown links (e.g. `[pkg::fun()]`), + roxygen2 now looks up the file it needs to link to, instead of linking to + the topic, to avoid "Non-file package-anchored links" `R CMD check` warnings. + # roxygen2 7.1.0 ## New features From b30da61a343ac87a846a4a01274f629bb15b94bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Sun, 14 Jun 2020 01:11:09 +0100 Subject: [PATCH 13/23] Add tests for unknown files/topics in re-exports --- tests/testthat/test-object-import.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-object-import.R b/tests/testthat/test-object-import.R index 57a27ddd2..fd1518de6 100644 --- a/tests/testthat/test-object-import.R +++ b/tests/testthat/test-object-import.R @@ -51,3 +51,14 @@ test_that("can't set description and re-export", { expect_length(out, 0) }) + +test_that("warnings for unknown packages and objects", { + expect_warning( + format(rd_section_reexport("11papaya", "fun")), + "Unavailable package in re-export" + ) + expect_warning( + format(rd_section_reexport("stringr", "12345543221")), + "Unavailable topic in re-export" + ) +}) From e8dece5e5bd8b4406f821be89224273ffdc24cf7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Sun, 14 Jun 2020 10:32:07 +0100 Subject: [PATCH 14/23] Fix link in note of @inheritDotParams We need to link to the file, not the topic. --- R/rd-inherit.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/rd-inherit.R b/R/rd-inherit.R index ac5b82cd1..f1b25ffa0 100644 --- a/R/rd-inherit.R +++ b/R/rd-inherit.R @@ -186,7 +186,13 @@ inherit_dot_params <- function(topic, topics, env) { # Build the Rd # (1) Link to function(s) that was inherited from src <- inheritors$source - dest <- ifelse(has_colons(src), gsub("::", ":", src), paste0("=", src)) + if (has_colons(src)) { + target <- str_split_fixed(src, "::", n = 2) + file <- find_topic_in_package(target[1], target[2]) + dest <- paste0(target[1], ":", file) + } else { + dest <- paste0("=", src) + } from <- paste0("\\code{\\link[", dest, "]{", src, "}}", collapse = ", ") # (2) Show each inherited argument From be0fd8259179b14fc1f6ed408df8b8b2432aa352 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Sun, 14 Jun 2020 10:32:44 +0100 Subject: [PATCH 15/23] Fix links in inherited docs We need to link to the file, instead of the topic. --- R/utils-rd.R | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/R/utils-rd.R b/R/utils-rd.R index 38d67fc0d..0fb548cbd 100644 --- a/R/utils-rd.R +++ b/R/utils-rd.R @@ -88,8 +88,14 @@ tweak_links <- function(x, package) { topic <- substr(opt, 2, nchar(opt)) if (has_topic(topic, package)) { - attr(x, "Rd_option") <- structure(paste0(package, ":", topic), Rd_tag = "TEXT") + file <- find_topic_in_package(package, topic) + attr(x, "Rd_option") <- structure(paste0(package, ":", file), Rd_tag = "TEXT") } + } else if (grepl(":", opt)) { + # need to fix the link to point to a file + target <- str_split_fixed(opt, ":", n = 2) + file <- find_topic_in_inherited_link(target[1], target[2]) + attr(x, "Rd_option") <- structure(paste0(target[1], ":", file), Rd_tag = "TEXT") } } } else if (length(x) > 0) { @@ -100,6 +106,22 @@ tweak_links <- function(x, package) { x } +find_topic_in_inherited_link <- function(pkg, topic) { + path <- tryCatch( + find_topic_in_package(pkg, topic), + error = function(err) { + roxy_warning("Unavailable package in inherited link: ", pkg, "::", topic) + topic + } + ) + if (is.na(path)) { + roxy_warning("Unavailable topic in inherited link: ", pkg, "::", topic) + topic + } else { + path + } +} + # helpers ----------------------------------------------------------------- parse_rd <- function(x) { From 1c2f7e655697c8bfa2e170e3b9d00fac837626fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 18 Jun 2020 11:44:04 +0100 Subject: [PATCH 16/23] Apply suggestions from code review Co-authored-by: Hadley Wickham --- R/rd-find-link-files.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/rd-find-link-files.R b/R/rd-find-link-files.R index 12a0e16ae..527d9abf8 100644 --- a/R/rd-find-link-files.R +++ b/R/rd-find-link-files.R @@ -20,7 +20,7 @@ #' #' @noRd -find_topic_filename <- function(pkg, topic, tag) { +find_topic_filename <- function(pkg, topic, tag = NULL) { tag <- tag %||% list(file = NA, line = NA) if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { topic From 2db56edf09aacb97544768ee1883d513da84738c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 18 Jun 2020 11:42:44 +0100 Subject: [PATCH 17/23] Link-to-file: fix comment --- R/markdown-link.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/markdown-link.R b/R/markdown-link.R index a359bcf42..494a52eb5 100644 --- a/R/markdown-link.R +++ b/R/markdown-link.R @@ -114,8 +114,7 @@ parse_link <- function(destination, contents, state) { ## `obj` is fun or obj (fun is without parens) ## `s4` is TRUE if we link to an S4 class (i.e. have -class suffix) ## `noclass` is fun with -class removed - ## `file` is the file name of the linked topic, if known. Otherwise random - ## id to fill in later. + ## `file` is the file name of the linked topic. is_code <- is_code || (grepl("[(][)]$", destination) && ! has_link_text) pkg <- str_match(destination, "^(.*)::")[1,2] From 51ecc2d0b2479b914dc81aa6e95255c80a03504c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 18 Jun 2020 14:19:19 +0100 Subject: [PATCH 18/23] Fix vectorization in inherited links That we just broke... --- R/rd-find-link-files.R | 10 ++++++++++ R/rd-inherit.R | 8 +------- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/R/rd-find-link-files.R b/R/rd-find-link-files.R index 527d9abf8..e764d6a86 100644 --- a/R/rd-find-link-files.R +++ b/R/rd-find-link-files.R @@ -61,3 +61,13 @@ find_topic_in_package <- function(pkg, topic) { raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) basename(utils::help((raw_topic), (pkg))[1]) } + +resolve_qualified_link <- function(topic) { + if (has_colons(topic)) { + target <- str_split_fixed(topic, "::", n = 2) + file <- find_topic_in_package(target[1], target[2]) + paste0(target[1], ":", file) + } else { + paste0("=", topic) + } +} diff --git a/R/rd-inherit.R b/R/rd-inherit.R index f1b25ffa0..c1c69f8e1 100644 --- a/R/rd-inherit.R +++ b/R/rd-inherit.R @@ -186,13 +186,7 @@ inherit_dot_params <- function(topic, topics, env) { # Build the Rd # (1) Link to function(s) that was inherited from src <- inheritors$source - if (has_colons(src)) { - target <- str_split_fixed(src, "::", n = 2) - file <- find_topic_in_package(target[1], target[2]) - dest <- paste0(target[1], ":", file) - } else { - dest <- paste0("=", src) - } + dest <- map_chr(src, resolve_qualified_link) from <- paste0("\\code{\\link[", dest, "]{", src, "}}", collapse = ", ") # (2) Show each inherited argument From 5cd97dcda8e92511fc34b9d64d6231c409d13a93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 18 Jun 2020 14:19:45 +0100 Subject: [PATCH 19/23] Refactor linked file finding code --- R/object-import.R | 17 ++++------- R/rd-find-link-files.R | 45 ++++++++++++++++++++--------- R/utils-rd.R | 17 ++++------- tests/testthat/test-markdown-link.R | 2 +- 4 files changed, 42 insertions(+), 39 deletions(-) diff --git a/R/object-import.R b/R/object-import.R index e1e97b1f8..174393e7b 100644 --- a/R/object-import.R +++ b/R/object-import.R @@ -41,17 +41,10 @@ format.rd_section_reexport <- function(x, ...) { } find_topic_in_package_reexp <- function(pkg, topic) { - path <- tryCatch( - find_topic_in_package(pkg, topic), - error = function(err) { - roxy_warning("Unavailable package in re-export: ", pkg, "::", topic) - topic - } + try_find_topic_in_package( + pkg, + topic, + "Unavailable package in re-export", + "Unavailable topic in re-export" ) - if (is.na(path)) { - roxy_warning("Unavailable topic in re-export: ", pkg, "::", topic) - topic - } else { - path - } } diff --git a/R/rd-find-link-files.R b/R/rd-find-link-files.R index e764d6a86..da8cd1f81 100644 --- a/R/rd-find-link-files.R +++ b/R/rd-find-link-files.R @@ -21,23 +21,10 @@ #' @noRd find_topic_filename <- function(pkg, topic, tag = NULL) { - tag <- tag %||% list(file = NA, line = NA) if (is.na(pkg) || identical(roxy_meta_get("current_package"), pkg)) { topic } else { - path <- tryCatch( - find_topic_in_package(pkg, topic), - error = function(err) { - roxy_tag_warning(tag, "Link to unavailable package: ", pkg, ". ", err$message) - topic - } - ) - if (is.na(path)) { - roxy_tag_warning(tag, "Link to unknown topic: ", topic, " in package ", pkg) - topic - } else { - path - } + try_find_topic_in_package(pkg, topic, tag = tag) } } @@ -62,6 +49,36 @@ find_topic_in_package <- function(pkg, topic) { basename(utils::help((raw_topic), (pkg))[1]) } +try_find_topic_in_package <- function(pkg, topic, + no_pkg_msg = "Link to unavailable package", + no_topic_msg = "Link to unknown topic", + tag = NULL) { + path <- tryCatch( + find_topic_in_package(pkg, topic), + error = function(err) { + msg <- paste0(no_pkg_msg, ": ", pkg, "::", topic, ". ", err$message) + if (is.null(tag)) { + roxy_warning(msg) + } else { + roxy_tag_warning(tag, msg) + } + topic + } + ) + + if (is.na(path)) { + msg <- paste0(no_topic_msg, ": ", pkg, "::", topic) + if (is.null(tag)) { + roxy_warning(msg) + } else { + roxy_tag_warning(tag, msg) + } + topic + } else { + path + } +} + resolve_qualified_link <- function(topic) { if (has_colons(topic)) { target <- str_split_fixed(topic, "::", n = 2) diff --git a/R/utils-rd.R b/R/utils-rd.R index 0fb548cbd..64d0230d6 100644 --- a/R/utils-rd.R +++ b/R/utils-rd.R @@ -107,19 +107,12 @@ tweak_links <- function(x, package) { } find_topic_in_inherited_link <- function(pkg, topic) { - path <- tryCatch( - find_topic_in_package(pkg, topic), - error = function(err) { - roxy_warning("Unavailable package in inherited link: ", pkg, "::", topic) - topic - } + try_find_topic_in_package( + pkg, + topic, + "Unavailable package in inherited link", + "Unavailable topic in inherited link" ) - if (is.na(path)) { - roxy_warning("Unavailable topic in inherited link: ", pkg, "::", topic) - topic - } else { - path - } } # helpers ----------------------------------------------------------------- diff --git a/tests/testthat/test-markdown-link.R b/tests/testthat/test-markdown-link.R index 5e759de60..cf9791bd5 100644 --- a/tests/testthat/test-markdown-link.R +++ b/tests/testthat/test-markdown-link.R @@ -130,7 +130,7 @@ test_that("short and sweet links work", { #' Description, see [name words][stringr::bar111]. #' @md foo <- function() {}")[[1]], - "Link to unknown topic: bar111 in package stringr" + "Link to unknown topic: stringr::bar111" ) out2 <- roc_proc_text(rd_roclet(), " #' Title From 59bdd0fa8f2d91d76259438675ce08660701bab5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 25 Jun 2020 11:13:22 +0100 Subject: [PATCH 20/23] Don't need dev rmarkdown any more --- .github/workflows/R-CMD-check.yaml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index c28c9390a..e639ee755 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -67,7 +67,6 @@ jobs: run: | remotes::install_deps(dependencies = TRUE) remotes::install_cran("rcmdcheck") - remotes::install_github("rstudio/rmarkdown") shell: Rscript {0} - name: Check From e7de910a56632f9f4b883d1c35db31955ed56610 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 25 Jun 2020 11:23:08 +0100 Subject: [PATCH 21/23] Close a dangling connection --- R/rd-find-link-files.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/rd-find-link-files.R b/R/rd-find-link-files.R index da8cd1f81..e0a8161dc 100644 --- a/R/rd-find-link-files.R +++ b/R/rd-find-link-files.R @@ -45,7 +45,9 @@ find_topic_filename <- function(pkg, topic, tag = NULL) { find_topic_in_package <- function(pkg, topic) { # This is needed because we have the escaped text here, and parse_Rd will # un-escape it properly. - raw_topic <- str_trim(tools::parse_Rd(textConnection(topic))[[1]][1]) + on.exit(close(con), add = TRUE) + con <- textConnection(topic) + raw_topic <- str_trim(tools::parse_Rd(con)[[1]][1]) basename(utils::help((raw_topic), (pkg))[1]) } From 9947c05af142b8311cedcc3e14ead7eda9d769b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 25 Jun 2020 11:33:31 +0100 Subject: [PATCH 22/23] Refactor link-to-file helpers --- R/object-import.R | 16 ++++++---------- R/rd-find-link-files.R | 12 ++++++------ R/utils-rd.R | 15 +++++---------- tests/testthat/test-object-import.R | 4 ++-- 4 files changed, 19 insertions(+), 28 deletions(-) diff --git a/R/object-import.R b/R/object-import.R index 174393e7b..35ea5f2bf 100644 --- a/R/object-import.R +++ b/R/object-import.R @@ -20,7 +20,12 @@ format.rd_section_reexport <- function(x, ...) { pkgs <- split(x$value$fun, x$value$pkg) pkg_links <- map2(names(pkgs), pkgs, function(pkg, funs) { funs <- sort(funs) - files <- vapply(funs, find_topic_in_package_reexp, character(1), pkg = pkg) + files <- map_chr( + funs, + try_find_topic_in_package, + pkg = pkg, + where = " in re-export" + ) links <- paste0( "\\code{\\link[", pkg, ifelse(files == funs, "", paste0(":", files)), @@ -39,12 +44,3 @@ format.rd_section_reexport <- function(x, ...) { "\n}}\n" ) } - -find_topic_in_package_reexp <- function(pkg, topic) { - try_find_topic_in_package( - pkg, - topic, - "Unavailable package in re-export", - "Unavailable topic in re-export" - ) -} diff --git a/R/rd-find-link-files.R b/R/rd-find-link-files.R index e0a8161dc..a9670fbf6 100644 --- a/R/rd-find-link-files.R +++ b/R/rd-find-link-files.R @@ -51,14 +51,14 @@ find_topic_in_package <- function(pkg, topic) { basename(utils::help((raw_topic), (pkg))[1]) } -try_find_topic_in_package <- function(pkg, topic, - no_pkg_msg = "Link to unavailable package", - no_topic_msg = "Link to unknown topic", - tag = NULL) { +try_find_topic_in_package <- function(pkg, topic, where = "", tag = NULL) { path <- tryCatch( find_topic_in_package(pkg, topic), error = function(err) { - msg <- paste0(no_pkg_msg, ": ", pkg, "::", topic, ". ", err$message) + msg <- paste0( + "Link to unavailable package", where, ": ", pkg, "::", + topic, ". ", err$message + ) if (is.null(tag)) { roxy_warning(msg) } else { @@ -69,7 +69,7 @@ try_find_topic_in_package <- function(pkg, topic, ) if (is.na(path)) { - msg <- paste0(no_topic_msg, ": ", pkg, "::", topic) + msg <- paste0("Link to unknown topic", where, ": ", pkg, "::", topic) if (is.null(tag)) { roxy_warning(msg) } else { diff --git a/R/utils-rd.R b/R/utils-rd.R index 64d0230d6..38c95331e 100644 --- a/R/utils-rd.R +++ b/R/utils-rd.R @@ -94,7 +94,11 @@ tweak_links <- function(x, package) { } else if (grepl(":", opt)) { # need to fix the link to point to a file target <- str_split_fixed(opt, ":", n = 2) - file <- find_topic_in_inherited_link(target[1], target[2]) + file <- try_find_topic_in_package( + target[1], + target[2], + where = " in inherited text" + ) attr(x, "Rd_option") <- structure(paste0(target[1], ":", file), Rd_tag = "TEXT") } } @@ -106,15 +110,6 @@ tweak_links <- function(x, package) { x } -find_topic_in_inherited_link <- function(pkg, topic) { - try_find_topic_in_package( - pkg, - topic, - "Unavailable package in inherited link", - "Unavailable topic in inherited link" - ) -} - # helpers ----------------------------------------------------------------- parse_rd <- function(x) { diff --git a/tests/testthat/test-object-import.R b/tests/testthat/test-object-import.R index fd1518de6..de983da34 100644 --- a/tests/testthat/test-object-import.R +++ b/tests/testthat/test-object-import.R @@ -55,10 +55,10 @@ test_that("can't set description and re-export", { test_that("warnings for unknown packages and objects", { expect_warning( format(rd_section_reexport("11papaya", "fun")), - "Unavailable package in re-export" + "[uU]navailable package in re-export" ) expect_warning( format(rd_section_reexport("stringr", "12345543221")), - "Unavailable topic in re-export" + "[uU]nknown topic in re-export" ) }) From 3dc1b0e7e583b95f9f81ab8f7c39d99947cd7e13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 25 Jun 2020 11:51:29 +0100 Subject: [PATCH 23/23] Do not qualify links to the current package R searches for topics in the linking package itself first, so these are not need to be qualified. Ignoring the 'mypackage::' part helps moving code between packages, e.g. for compat files. --- R/markdown-link.R | 2 ++ tests/testthat/test-markdown-link.R | 10 ++++++++++ 2 files changed, 12 insertions(+) diff --git a/R/markdown-link.R b/R/markdown-link.R index 494a52eb5..f47957f4d 100644 --- a/R/markdown-link.R +++ b/R/markdown-link.R @@ -116,9 +116,11 @@ parse_link <- function(destination, contents, state) { ## `noclass` is fun with -class removed ## `file` is the file name of the linked topic. + thispkg <- roxy_meta_get("current_package") %||% "" is_code <- is_code || (grepl("[(][)]$", destination) && ! has_link_text) pkg <- str_match(destination, "^(.*)::")[1,2] pkg <- gsub("%", "\\\\%", pkg) + if (!is.na(pkg) && pkg == thispkg) pkg <- NA_character_ fun <- utils::tail(strsplit(destination, "::", fixed = TRUE)[[1]], 1) fun <- gsub("%", "\\\\%", fun) is_fun <- grepl("[(][)]$", fun) diff --git a/tests/testthat/test-markdown-link.R b/tests/testthat/test-markdown-link.R index cf9791bd5..e7c07cfdd 100644 --- a/tests/testthat/test-markdown-link.R +++ b/tests/testthat/test-markdown-link.R @@ -436,3 +436,13 @@ test_that("markup in link text", { foo <- function() {}")[[1]] expect_equivalent_rd(out1, out2) }) + +test_that("linking to self is unqualified", { + old <- roxy_meta_set("current_package", "myself") + on.exit(roxy_meta_set("current_package", old), add = TRUE) + rd <- markdown("foo [myself::fun()] and [myself::obj] bar") + expect_equal( + rd, + "foo \\code{\\link[=fun]{fun()}} and \\link{obj} bar" + ) +})