diff --git a/src/library/tools/R/Rd2HTML.R b/src/library/tools/R/Rd2HTML.R index 7fe66d8e81..60153553e1 100644 --- a/src/library/tools/R/Rd2HTML.R +++ b/src/library/tools/R/Rd2HTML.R @@ -1625,24 +1625,33 @@ function(dir) ## achieve this by adding the canonicalized ORCID id (URL) to the ## 'family' element and simultaneously dropping the ORCID id from ## the 'comment' element, and then re-format. - .format_authors_at_R_field_with_expanded_ORCID_identifier <- function(a) { + ## See for ROR display + ## guidelines. + .format_authors_at_R_field_with_expanded_identifiers <- function(a) { x <- utils:::.read_authors_at_R_field(a) format_person1 <- function(e) { - comment <- e$comment - pos <- which((names(comment) == "ORCID") & - grepl(.ORCID_iD_variants_regexp, comment)) - if((len <- length(pos)) > 0L) { + cmt <- e$comment + pos <- which((names(cmt) == "ORCID") & + grepl(.ORCID_iD_variants_regexp, cmt)) + if(length(pos) == 1L) { e$family <- c(e$family, - paste0("<", - paste0("https://replace.me.by.orcid.org/", - .ORCID_iD_canonicalize(comment[pos])), - ">")) - e$comment <- if(len < length(comment)) - comment[-pos] - else - NULL + sprintf("", + .ORCID_iD_canonicalize(cmt[pos]))) + cmt <- cmt[-pos] } + ## Of course, a person should not have both ORCID and ROR + ## identifiers: could check for that. + pos <- which((names(cmt) == "ROR") & + grepl(.ROR_ID_variants_regexp, cmt)) + if(length(pos) == 1L) { + e$family <- + c(e$family, + sprintf("", + .ROR_ID_canonicalize(cmt[pos]))) + cmt <- cmt[-pos] + } + e$comment <- if(length(cmt)) cmt else NULL e } x <- lapply(unclass(x), format_person1) @@ -1675,7 +1684,7 @@ function(dir) if(!is.na(aatr)) desc["Author"] <- - .format_authors_at_R_field_with_expanded_ORCID_identifier(aatr) + .format_authors_at_R_field_with_expanded_identifiers(aatr) ## Take only Title and Description as *text* fields. desc["Title"] <- htmlify_text(desc["Title"]) @@ -1723,6 +1732,18 @@ function(dir) "style=\"width:16px; height:16px; margin-left:4px; margin-right:4px; vertical-align:middle\"", " />"), desc["Author"]) + desc["Author"] <- + gsub(sprintf("<https://replace.me.by.ror.org/(%s)>", + .ROR_ID_regexp), + paste0("", + "\"ROR"), + desc["Author"]) } desc["License"] <- htmlify_license_spec(desc["License"], pack) diff --git a/src/library/tools/R/rortools.R b/src/library/tools/R/rortools.R new file mode 100644 index 0000000000..0937336b97 --- /dev/null +++ b/src/library/tools/R/rortools.R @@ -0,0 +1,82 @@ +# File src/library/tools/R/rortools.R +# Part of the R package, https://www.R-project.org +# +# Copyright (C) 2025 The R Core Team +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# A copy of the GNU General Public License is available at +# https://www.R-project.org/Licenses/ + +## See : +## A ROR ID consists of a unique 9-character string appended to the +## ROR domain. The preferred form of a ROR identifier is the entire +## URL: https://ror.org/02mhbdp94 rather than ror.org/02mhbdp94 or +## 02mhbdp94, although the ROR API will recognize all three of these +## forms as ROR IDs. +## So apparently the unique 9-character string is not the ROR ID and has +## no name to refer to ... argh. For now, name things as we do for +## ORCID iDs. + +### ** .ROR_ID_regexp + +.ROR_ID_regexp <- + ".{9}" + +### ** .ROR_ID_variants_regexp + +.ROR_ID_variants_regexp <- + sprintf("^?$", .ROR_ID_regexp) + +### ** .ROR_ID_canonicalize + +.ROR_ID_canonicalize <- function(x) + sub(.ROR_ID_variants_regexp, "\\3", x) + +### ** .ROR_ID_is_valid + +.ROR_ID_is_valid <- function(x) + grepl(.ROR_ID_variants_regexp, x) + +### ** .ROR_ID_is_alive + +## See + +### ** ROR_ID_from_person + +ROR_ID_from_person <- function(x) + vapply(unclass(x), + function(e) e$comment["ROR"] %||% NA_character_, + "") + +### ** ROR_ID_db_from_package_sources + +ROR_ID_db_from_package_sources <- +function(dir, add = FALSE) +{ + ids1 <- ROR_ID_from_person(.persons_from_metadata(dir)) + ids1 <- ids1[!is.na(ids1)] + ids2 <- ROR_ID_from_person(.persons_from_citation(dir)) + ids2 <- ids2[!is.na(ids2)] + db <- data.frame(ID = c(character(), ids1, ids2), + Parent = c(rep_len("DESCRIPTION", + length(ids1)), + rep_len("inst/CITATION", + length(ids2)))) + if(add) + db$Parent <- file.path(basename(dir), db$Parent) + db +} + +### Local variables: *** +### mode: outline-minor *** +### outline-regexp: "### [*]+" *** +### End: *** diff --git a/src/library/utils/R/citation.R b/src/library/utils/R/citation.R index 6a61e90ed1..8ed0fb9cd9 100644 --- a/src/library/utils/R/citation.R +++ b/src/library/utils/R/citation.R @@ -140,6 +140,18 @@ function(given = NULL, family = NULL, middle = NULL, domain = NA) } } + if(any(ind <- (names(comment) == "ROR"))) { + ids <- comment[ind] + bad <- which(!tools:::.ROR_ID_is_valid(ids)) + if(length(bad)) { + warning(sprintf(ngettext(length(bad), + "Invalid ROR ID: %s.", + "Invalid ROR IDs: %s."), + paste(sQuote(ids[bad]), + collapse = ", ")), + domain = NA) + } + } } rval <- list(given = given, family = family, role = role, @@ -419,6 +431,12 @@ function(x) names(chunks)[i] <- "ORCID" comment <- chunks } + if(any(i <- grepl(tools:::.ROR_ID_variants_regexp, + chunks))) { + chunks[i] <- tools:::.ROR_ID_canonicalize(chunks[i]) + names(chunks)[i] <- "ROR" + comment <- chunks + } } x <- sub("[[:space:]]*\\([^)]*\\)", "", x) email <- if(grepl("<.*>", x)) @@ -538,7 +556,8 @@ function(x, if(any(include == "comment")) x <- lapply(x, function(e) { - u <- .expand_ORCID_identifier(e$comment, style) + u <- .expand_person_comment_identifiers(e$comment, + style) if(!is.null(v <- names(u))) { i <- which(nzchar(v)) if(length(i)) @@ -602,7 +621,7 @@ function(object, escape = FALSE, ...) y } -.expand_ORCID_identifier <- +.expand_person_comment_identifiers <- function(x, style = "text") { if(any(ind <- ((names(x) == "ORCID") & @@ -614,6 +633,15 @@ function(x, style = "text") else sprintf("", oid) } + if(any(ind <- ((names(x) == "ROR") & + grepl(tools:::.ROR_ID_variants_regexp, x)))) { + rid <- tools:::.ROR_ID_canonicalize(x[ind]) + x[ind] <- if(style == "md") + sprintf("[ROR %s](https://ror.org/%s)", + rid, rid) + else + sprintf("", rid) + } x } diff --git a/src/library/utils/man/person.Rd b/src/library/utils/man/person.Rd index 42975ff57f..62914d75b4 100644 --- a/src/library/utils/man/person.Rd +++ b/src/library/utils/man/person.Rd @@ -171,7 +171,8 @@ as.person(x) taken to give \abbr{ORCID} identifiers (see \url{https://orcid.org/} for more information), and be displayed as the corresponding \abbr{URI}s by the \code{print()} and \code{format()} methods (see \bold{Examples} - below). + below). Similarly, elements named \code{"ROR"} will be taken to give + \abbr{ROR} identifiers (see \url{https://ror.org/}). Where more than one entity is given a \code{"cph"} role, the \code{comment} field should be used to delimit who owns the copyright @@ -221,4 +222,8 @@ toBibtex(b) ## ORCID identifiers. (p3 <- person("Achim", "Zeileis", comment = c(ORCID = "0000-0003-0918-3766"))) + +## ROR identifiers. +(p4 <- person("R Core Team", + comment = c(ROR = "02zz1nj61"))) }