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