From 691026b98ed96a965e9beae329b4a45427dc72f4 Mon Sep 17 00:00:00 2001 From: hornik Date: Thu, 27 Jul 2023 09:26:51 +0000 Subject: [PATCH] Add and use .DESCRIPTION_to_HTML(). git-svn-id: https://svn.r-project.org/R/trunk@84760 00db46b3-68df-0310-9c12-caf00c1e9a41 --- src/library/tools/R/Rd2HTML.R | 145 ++++++++++++++++++++++++++++++ src/library/tools/R/dynamicHelp.R | 10 ++- 2 files changed, 154 insertions(+), 1 deletion(-) diff --git a/src/library/tools/R/Rd2HTML.R b/src/library/tools/R/Rd2HTML.R index fb6df668eb3..225e2a78002 100644 --- a/src/library/tools/R/Rd2HTML.R +++ b/src/library/tools/R/Rd2HTML.R @@ -1280,3 +1280,148 @@ function(dir) .find_HTML_links_in_package)) } +.DESCRIPTION_to_HTML <- function(descfile) { + + ## Similar to .DESCRIPTION_to_latex(). + + trfm <- .gsub_with_transformed_matches + + ## A variant of htmlify() which optionally adds hyperlinks and does + ## not HTMLify dashes inside these. + htmlify_text <- function(x, a = FALSE, d = FALSE) { + ## Use 'd' to indicate HTMLifying Description texts, + ## transforming DOI and arXiv pseudo-URIs. + x <- fsub("&", "&", x) + x <- fsub("``", "“", x) + x <- fsub("''", "”", x) + x <- psub("`([^']+)'", "‘\\1’", x) + x <- fsub("`", "'", x) + x <- fsub("<", "<", x) + x <- fsub(">", ">", x) + if(a) { + ## CRAN also transforms + ## "<(URL: *)?((https?|ftp)://[^[:space:]]+)[[:space:]]*>" + ## + ## Sync regexp with what we use in .DESCRIPTION_to_latex()? + x <- trfm("([^>\"])((https?|ftp)://[[:alnum:]/.:@+\\_~%#?=&;,-]+[[:alnum:]/])", + "\\1\\2", + x, + urlify, + 2L) + ## + } + if(d) { + x <- trfm("<(DOI|doi):[[:space:]]*([^<[:space:]]+[[:alnum:]])>", + "<doi:\\2>", + x, + ## + ## Why not urlify? + function(u) utils::URLencode(u, TRUE), + ## + 2L) + x <- trfm("<(arXiv|arxiv):([[:alnum:]/.-]+)([[:space:]]*\\[[^]]+\\])?>", + "<arXiv:\\2\\3>", + x, + urlify, + 2L) + } + if(a || d) { + ## Avoid mdash/ndash htmlification in the anchored parts. + m <- gregexpr("]*\">[^<>]*", x) + regmatches(x, m, invert = TRUE) <- + lapply(regmatches(x, m, invert = TRUE), + function(x) { + x <- fsub("---", "—", x) + x <- fsub("--", "–", x) + x + }) + } else { + x <- fsub("---", "—", x) + x <- fsub("--", "–", x) + } + x + } + + htmlify_compare_ops <- function(x) { + x <- fsub("<=", "≤", x) + x <- fsub(">=", "≥", x) + x <- fsub("!=", "≠", x) + x + } + + desc <- enc2utf8(.read_description(descfile)) + aatr <- desc["Authors@R"] + ## + ## .DESCRIPTION_to_latex() drops the + ## Package Packaged Built + ## fields: why? Should we do the same? + ## Note that the package name will be used for the title in the HTML + ## refman, so perhaps really drop. + desc <- desc[names(desc) %w/o% + c("Package", "Authors@R")] + ## + + ## + ## What should we do with email addresses in the + ## Author Maintainer Contact + ## fields? + ## CRAN obfuscates, .DESCRIPTION_to_latex() uses \email which only + ## adds markup but does not create mailto: URLs. + ## + + ## Take only Title and Description as *text* fields. + desc["Title"] <- htmlify_text(desc["Title"]) + desc["Description"] <- + htmlify_text(desc["Description"], a = TRUE, d = TRUE) + ## Now the other fields. + fields <- setdiff(names(desc), + c("Title", "Description")) + theops <- intersect(fields, + c("Depends", "Imports", "LinkingTo", + "Suggests", "Enhances")) + desc[fields] <- fsub("&", "&", desc[fields]) + ## Do this before turning '<' and '>' to HTML entities. + desc[theops] <- htmlify_compare_ops(desc[theops]) + ## Do this before adding HTML markup ... + desc[fields] <- fsub("<", "<", desc[fields]) + desc[fields] <- fsub(">", ">", desc[fields]) + ## HTMLify URLs and friends. + for(f in intersect(fields, + c("URL", "BugReports", + "Additional_repositories"))) { + ## The above already changed & to & which urlify will + ## do once more ... + trafo <- function(s) urlify(gsub("&", "&", s)) + desc[f] <- trfm("(^|[^>\"])((https?|ftp)://[^[:space:],]*)", + "\\1\\2", + desc[f], + trafo, + 2L) + } + + ## + ## The CRAN code re-creates suitably formatted Authors from + ## Authors@R if available, and replaces ORCID URLs by hyperlinked + ## ORCID logos. We could so the same, but then we would also need + ## to ship the logo. + ## For now, do simply hyperlinks. + if(!is.na(aatr)) { + desc["Author"] <- + gsub(sprintf("<(https://orcid.org/%s)>", + .ORCID_iD_regexp), + "\\1", + gsub("\n", "
", desc["Author"])) + } + ## + + ## + ## For dynamic help we should be able to further enhance by + ## hyperlinking file pointers to + ## LICENSE LICENCE AUTHORS COPYRIGHTS + ## + + c("", + sprintf("\n\n\n", + names(desc), desc), + "
%s:%s
") +} diff --git a/src/library/tools/R/dynamicHelp.R b/src/library/tools/R/dynamicHelp.R index 154fa77db46..f6d69a47f73 100644 --- a/src/library/tools/R/dynamicHelp.R +++ b/src/library/tools/R/dynamicHelp.R @@ -311,6 +311,14 @@ httpd <- function(path, query, ...) list(payload = paste(out, collapse = "\n")) } + .HTML_package_description <- function(descfile) { + pkg <- basename(dirname(descfile)) + out <- c(HTMLheader(sprintf("Package ‘%s’", pkg)), + .DESCRIPTION_to_HTML(descfile), + "") + list(payload = paste(out, collapse = "\n")) + } + unfix <- function(file) { ## we need to re-fix links altered by fixup.package.URLs ## in R < 2.10.0 @@ -668,7 +676,7 @@ httpd <- function(path, query, ...) if(grepl(descRegexp, path)) { pkg <- sub(descRegexp, "\\1", path) file <- system.file("DESCRIPTION", package = pkg) - return(list(file = file, "content-type" = paste0("text/plain", charsetSetting(pkg)))) + return(.HTML_package_description(file)) } else return(error_page(gettextf("Only help files, %s, %s and files under %s and %s in a package can be viewed", mono("NEWS"), mono("DESCRIPTION"), mono("doc/"), mono("demo/"))))