|
| 1 | +ctv2htmldebug <- function (x, file = NULL, cran = FALSE, css = NULL, packageURL = NULL, |
| 2 | + reposname = "CRAN") |
| 3 | +{ |
| 4 | + |
| 5 | + if (is.character(x)) |
| 6 | + x <- read.ctv(x, cran = cran) |
| 7 | + if (is.null(file)) |
| 8 | + file <- paste0(x$name, ".html") |
| 9 | + if (is.null(css) & cran) |
| 10 | + css <- "../CRAN_web.css" |
| 11 | + if (is.null(x$url) & cran) |
| 12 | + x$url <- paste0("https://CRAN.R-project.org/view=", x$name) |
| 13 | + if (is.null(packageURL)) { |
| 14 | + packageURL <- if (cran) |
| 15 | + "../packages/" |
| 16 | + else "https://CRAN.R-project.org/package=%s" |
| 17 | + } |
| 18 | + ampersSub <- function(x) gsub("&", "&", x) |
| 19 | + obfuscate <- function(x) paste(sprintf("&#x%x;", as.integer(sapply(unlist(strsplit(gsub("@", |
| 20 | + " at ", x), NULL)), charToRaw))), collapse = "") |
| 21 | + for (i in 1:length(x)) if (is.character(x[[i]])) |
| 22 | + Encoding(x[[i]]) <- "unknown" |
| 23 | + title <- paste0(reposname, " Task View: ", ctv:::htmlify(x$topic)) |
| 24 | + htm1 <- c("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">", |
| 25 | + "<html xmlns=\"http://www.w3.org/1999/xhtml\">", "<head>", |
| 26 | + paste0(" <title>", title, "</title>"), if (!is.null(css)) paste0(" <link rel=\"stylesheet\" type=\"text/css\" href=\"", |
| 27 | + css, "\" />"), " <meta http-equiv=\"content-type\" content=\"text/html; charset=UTF-8\" />", |
| 28 | + sprintf(" <meta name=\"citation_title\" content=\"%s\" />", |
| 29 | + title), sprintf(" <meta name=\"citation_author\" content=\"%s\" />", |
| 30 | + ctv:::htmlify(x$maintainer)), sprintf(" <meta name=\"citation_publication_date\" content=\"%s\" />", |
| 31 | + x$version), if (!is.null(x$url)) sprintf(" <meta name=\"citation_public_url\" content=\"%s\" />", |
| 32 | + x$url), sprintf(" <meta name=\"DC.title\" content=\"%s\" />", |
| 33 | + title), sprintf(" <meta name=\"DC.creator\" content=\"%s\" />", |
| 34 | + ctv:::htmlify(x$maintainer)), sprintf(" <meta name=\"DC.issued\" content=\"%s\" />", |
| 35 | + x$version), if (!is.null(x$url)) sprintf(" <meta name=\"DC.identifier\" content=\"%s\" />", |
| 36 | + x$url), "</head>", "", "<body>", paste0(" <h2>", |
| 37 | + reposname, " Task View: ", ctv:::htmlify(x$topic), "</h2>"), |
| 38 | + paste0(" <table summary=\"", x$name, " task view information\">"), |
| 39 | + paste0(" <tr><td valign=\"top\"><b>Maintainer:</b></td><td>", |
| 40 | + ctv:::htmlify(x$maintainer), "</td></tr>"), if (!is.null(x$email)) paste0(" <tr><td valign=\"top\"><b>Contact:</b></td><td>", |
| 41 | + obfuscate(x$email), "</td></tr>"), paste0(" <tr><td valign=\"top\"><b>Version:</b></td><td>", |
| 42 | + ctv:::htmlify(x$version), "</td></tr>"), if (!is.null(x$url)) paste0(" <tr><td valign=\"top\"><b>URL:</b></td><td><a href=\"", |
| 43 | + ctv:::htmlify(x$url), "\">", ctv:::htmlify(x$url), "</a></td></tr>"), |
| 44 | + if (!is.null(x$source)) paste0(" <tr><td valign=\"top\"><b>Source:</b></td><td><a href=\"", |
| 45 | + ctv:::htmlify(x$source), "\">", ctv:::htmlify(x$source), "</a></td></tr>"), |
| 46 | + " </table>") |
| 47 | + htm2 <- x$info |
| 48 | + pkg2html <- if (grepl("%s", packageURL, fixed = TRUE)) { |
| 49 | + function(a, b) paste0(" <li><a href=\"", sprintf(packageURL, |
| 50 | + a), "\">", a, "</a>", if (b) |
| 51 | + " (core)" |
| 52 | + else "", "</li>") |
| 53 | + } |
| 54 | + else { |
| 55 | + function(a, b) paste0(" <li><a href=\"", packageURL, |
| 56 | + a, "/index.html\">", a, "</a>", if (b) |
| 57 | + " (core)" |
| 58 | + else "", "</li>") |
| 59 | + } |
| 60 | + htm3 <- c(paste0(" <h3>", reposname, " packages:</h3>"), |
| 61 | + " <ul>", sapply(1:NROW(x$packagelist), function(i) pkg2html(x$packagelist[i, |
| 62 | + 1], x$packagelist[i, 2])), " </ul>") |
| 63 | + htm4 <- c(" <h3>Related links:</h3>", " <ul>", sapply(x$links, |
| 64 | + function(x) paste0(" <li>", x, "</li>")), " </ul>") |
| 65 | + if (!is.null(x$otherlinks)) { |
| 66 | + htm4 <- c(htm4, "", " <h3>Other resources:</h3>", " <ul>", |
| 67 | + sapply(x$otherlinks, function(x) paste0(" <li>", |
| 68 | + x, "</li>")), " </ul>") |
| 69 | + } |
| 70 | + print(class(htm1)) |
| 71 | + print(class(htm2)) |
| 72 | + print(class(htm3)) |
| 73 | + print(class(htm4)) |
| 74 | + if(is.list(htm1)) |
| 75 | + stop("header section is a list and not a vector") |
| 76 | + if(is.list(htm2)) |
| 77 | + stop("body is a list and not a vector") |
| 78 | + if(is.list(htm3)) |
| 79 | + stop("package list section is a list and not a vector") |
| 80 | + if(is.list(htm4)) |
| 81 | + stop("links section is a list and not a vector") |
| 82 | + |
| 83 | + htm <- c(htm1, "", htm2, "", htm3, "", htm4, "", "</body>", |
| 84 | + "</html>") |
| 85 | + #print(head(htm)) |
| 86 | + htm.len <- sapply(htm, length) |
| 87 | + print(htm[htm.len > 1]) |
| 88 | + print(table(htm.class <- sapply(htm, class))) |
| 89 | + stopifnot(all(inherits(htm.class, "character"))) |
| 90 | + writeLines(htm, con = file) |
| 91 | + invisible(htm) |
| 92 | +} |
| 93 | + |
| 94 | +ctv2htmldebug("Distributions.md") |
0 commit comments