Enhancements for dynamic help.

git-svn-id: https://svn.r-project.org/R/trunk@84764 00db46b3-68df-0310-9c12-caf00c1e9a41

src/library/tools/R/Rd2HTML.R

@@ -1376,18 +1376,15 @@ function(dir)
  ## License file pointers.
  ## <FIXME>
  ## For now only hyperlink for dynamic help.
- ## Once httpd() knows about packageLicenseFileRegexp
  re <- "(.*[^[:space:]])?(([[:space:]]*\\+[[:space:]]*)?file )(LICEN[CS]E)"
  ind <- grepl(re, expansions)
  if(any(ind)) {
  y[ind] <-
  sub(re,
- ## </FIXME>
- ## packageLicenseFileRegexp
- ## sprintf("\\2<a href=\"/library/%s/\\4\">\\4</a>",
- ## p),
- "\\2\\4",
- ## </FIXME>
+ if(dynamic) {
+ sprintf("\\2<a href=\"/library/%s/\\4\">\\4</a>",
+ p)
+ } else "\\2\\4",
  expansions[ind])
  expansions[ind] <- sub(re, "\\1", expansions[ind])
  }
@@ -1396,20 +1393,19 @@ function(dir)
  ## Components with labels in the R license db.
  ## For dynamic help, use the common licenses shipped with R
  ## instead of the R-project.org license URLs.
- ## Once httpd() knows about commonLicenseFilesRegexp.
  ldb <- R_license_db()
  pos <- match(expansions, ldb$Labels)
  ind <- !is.na(pos)
  if(any(ind)) {
  pos <- pos[ind]
- ## <FIXME>
- ## commonLicenseFilesRegexp
- ## paths <- ldb[pos, "File"]
- ## urls <- ifelse(nzchar(paths),
- ## sprintf("../../licenses/%s", basename(paths)),
- ## ldb[pos, "URL"])
- urls <- ldb[pos, "URL"]
- ## </FIXME>
+ urls <- if(dynamic) {
+  paths <- ldb[pos, "File"]
+  ifelse(nzchar(paths),
+  sprintf("/licenses/%s",
+   basename(paths)),
+   ldb[pos, "URL"])
+  } else
+  urls <- ldb[pos, "URL"]
  texts <- if(expanded) {
  expansions[ind]
  } else {

src/library/tools/R/dynamicHelp.R

@@ -314,7 +314,7 @@ httpd <- function(path, query, ...)
  .HTML_package_description <- function(descfile) {
  pkg <- basename(dirname(descfile))
  out <- c(HTMLheader(sprintf("Package &lsquo;%s&rsquo;", pkg)),
- .DESCRIPTION_to_HTML(descfile),
+ .DESCRIPTION_to_HTML(descfile, dynamic = TRUE),
  "</div></body></html>")
  list(payload = paste(out, collapse = "\n"))
  }
@@ -376,6 +376,11 @@ httpd <- function(path, query, ...)
  formatted <- toHTML(news, title = "R News")
  return( list(payload = paste(formatted, collapse="\n")) )
  }
+ else if(grepl("^/licenses/([^/.]*)$", path) &&
+ file.exists(file <- file.path(R.home("share"), "licenses",
+ basename(path))))
+ return(list(file = file,
+ "content-type" = "text/plain; charset=utf-8"))
  else if(!grepl("^/(doc|library|session)/", path))
  return(error_page(paste("Only NEWS and URLs under", mono("/doc"),
  "and", mono("/library"), "are allowed")))
@@ -386,7 +391,6 @@ httpd <- function(path, query, ...)
  else if(path == "/doc/html/hsearch_db_keywords.html")
  return(.HTML_hsearch_db_keywords())
 
-
  ## ----------------------- per-package documentation ---------------------
  ## seems we got ../..//<pkg> in the past
  fileRegexp <- "^/library/+([^/]*)/html/([^/]*)\\.html$"
@@ -399,6 +403,8 @@ httpd <- function(path, query, ...)
  newsRegexp <- "^/library/([^/]*)/NEWS$"
  figureRegexp <- "^/library/([^/]*)/(help|html)/figures/([^/]*)$"
  sessionRegexp <- "^/session/"
+ packageIndexRegexp <- "^/library/([^/]*)$"
+ packageLicenseFileRegexp <- "^/library/([^/]*)/(LICEN[SC]E$)"
 
  file <- NULL
  if (grepl(topicRegexp, path)) {
@@ -671,6 +677,22 @@ httpd <- function(path, query, ...)
  pkg <- sub(cssRegexp, "\\1", path)
  return( list(file = system.file("html", "R.css", package = pkg),
  "content-type" = "text/css") )
+ } else if(grepl(packageIndexRegexp, path)) {
+ ## <FIXME>
+ ## Can we do this better?
+ url <- paste0(path, "/html/00Index.html")
+ return(list(payload = paste0('Redirect to <a href="', url, '">"',
+ url, '"</a>'),
+ "content-type" = 'text/html',
+ header = paste0('Location: ', url),
+ "status code" = 302L)) # temporary redirect
+ ## </FIXME>
+ } else if(grepl(packageLicenseFileRegexp, path) &&
+ file.exists(file <- system.file(basename(path),
+ package =
+ basename(dirname(path))))) {
+ return(list(file = file,
+ "content-type" = "text/plain; charset=utf-8"))
  } else if (startsWith(path, "/library/")) {
  descRegexp <- "^/library/+([^/]+)/+DESCRIPTION$"
  if(grepl(descRegexp, path)) {