toHTML <- function(x, ...) UseMethod("toHTML") # # Copyright (C) 1995-2013 The R Core Team HTMLheader <- function(title="R", logo=TRUE, up=NULL, top=file.path(Rhome, "doc/html/index.html"), Rhome="", css = file.path(Rhome, "doc/html/R.css"), headerTitle = paste("R:", title), outputEncoding = "UTF-8") { result <- c('', paste0('', headerTitle, ''), paste0(''), paste0(''), '', paste('

', title)) if (logo) result <- c(result, paste0('')) result <- c(result, '

', '

') if (!is.null(up) || !is.null(top)) { result <- c(result, '

') if (!is.null(up)) result <- c(result, paste0('

')) if (!is.null(top)) result <- c(result, paste0('

')) result <- c(result, '

') } result } toHTML.packageIQR <- function(x, ...) { db <- x$results # Re-encode as utf-8 x$title <- iconv(x$title, to="UTF-8") x$footer <- iconv(x$footer, to="UTF-8") db <- iconv(db, to="UTF-8") ## Split according to Package. out <- if(nrow(db) == 0L) NULL else lapply(split(1:nrow(db), db[, "Package"]), function(ind) db[ind, c("Item", "Title"), drop = FALSE]) result <- HTMLheader(...) for(pkg in names(out)) { result <- c(result, paste0('

', htmlify(x$title), ' in package ‘', htmlify(pkg), '’

'), '', paste0('\n', ' \n \n\n'), '

\n', htmlify(out[[pkg]][, "Item"]), '\n

\n', htmlify(out[[pkg]][, "Title"]), '\n

') } if(!is.null(x$footer)) result <- c(result, '

', htmlify(x$footer), '

') result <- c(result, '') result } toHTML.news_db <- function(x, ...) { ## local version htmlify2 <- function(x) { x <- psub("<([[:alnum:]._]+)>", "@VAR@\\1@EVAR@", x) x <- fsub("&", "&", x) x <- fsub("---", "—", x) ## usually a flag like --timing ## x <- fsub("--", "–", x) x <- fsub("``", "“", x) x <- fsub("''", "”", x) x <- psub("`([^']+)'", "‘\\1’", x) x <- fsub("`", "'", x) x <- fsub("<", "<", x) x <- fsub(">", ">", x) x <- fsub("@VAR@", "", x) x <- fsub("@EVAR@", "", x) x } ## For now, only do something if the NEWS file could be read without ## problems, see utils:::print.news_db(): if(is.null(bad <- attr(x, "bad")) || (length(bad) != NROW(x)) || any(bad)) return(character()) print_items <- function(x) c("

") x$Text <- iconv(x$Text, to = "UTF-8") vchunks <- split(x, x$Version) vchunks <- vchunks[order(as.numeric_version(sub(" *patched", ".1", names(vchunks))), decreasing = TRUE)] vheaders <- sprintf("

Changes in version %s

", names(vchunks)) c(HTMLheader(...), unlist(lapply(seq_along(vchunks), function(i) { vchunk <- vchunks[[i]] if(all(!is.na(category <- vchunk$Category) & nzchar(category))) { ## need to preserve order of headings. cchunks <- split(vchunk, factor(category, levels=unique(category))) c(vheaders[i], Map(function(h, t) c(h, print_items(t$Text)), sprintf("

%s

", names(cchunks)), cchunks)) } else { c(vheaders[i], print_items(vchunk$Text)) } }) ), "") } # To support static linking, URLs should be relative. # Argument "depth" below says how far down in the hierarchy # we are starting from, e.g. /library/stats/html/mean.html # is depth 3 makeVignetteTable <- function(vignettes, depth=2) { out <- c('', '', '', '', '', '', '') for (i in seq_len(nrow(vignettes))) { Outfile <- vignettes[i, "PDF"] topic <- file_path_sans_ext(Outfile) Title <- vignettes[i, "Title"] File <- vignettes[i, "File"] R <- vignettes[i, "R"] pkg <- vignettes[i, "Package"] root <- c(rep("../", depth), "library/", pkg, "/doc/") link <- c('', pkg, "::", topic, '') line <- c('\n\n\n\n') out <- c(out, paste(line, collapse='')) } c(out, '

', link, '

', Title, '

', if (nchar(Outfile)) c('', vignette_type(Outfile), ''), '

', 'source', '

', if (nchar(R)) c('R code'), '

') } makeDemoTable <- function(demos, depth=2) { out <- c('', '', '', '', '') for (i in seq_len(nrow(demos))) { topic <- demos[i, "topic"] pkg <- demos[i, "Package"] root <- c(rep("../", depth), "library/", pkg, "/") Title <- demos[i, "title"] path <- file.path(demos[i, "LibPath"], "demo") files <- basename(list_files_with_type(path, "demo", full.names=FALSE)) file <- files[topic == file_path_sans_ext(files)] if (length(file) == 1) { link <- c('', pkg, "::", topic, '') runlink <- c(' (Run demo in console)') } else { link <- c(pkg, "::", topic) runlink <- "" } line <- c('\n\n') out <- c(out, paste(line, collapse='')) } c(out, '

', link, '

', Title, '

', runlink, '

') } makeHelpTable <- function(help, depth=2) { out <- c('', '', '', '') pkg <- help[,"Package"] root <- paste0(paste(rep.int("../", depth), collapse=""), "library/", pkg, "/html/") topic <- help[, "topic"] Title <- help[, "title"] name <- help[, "name"] links <- paste0('', ifelse(nchar(pkg), paste0(pkg, "::"), ""), topic, '') lines <- paste0('\n') c(out, lines, '

', links, '

', Title, '

') }