R/openPage.R
In JasonHackney/ReportingTools: Tools for making reports in various formats
Defines functions
startHTMLReport
makePageEnd
#lifted the openPage function from hwriter package by Gregoire Pau
makePageStart = function ( title = "Title!", link.javascript = NULL,
link.css = NULL, css = NULL, head = NULL, charset = "utf-8",
lang = "en", head.attributes = NULL, body.attributes = NULL)
{
doctype = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n"
meta = hmakeTag("meta", NULL, `http-equiv` = "Content-Type",
content = paste("text/html; charset=", charset, sep = ""),
newline = FALSE)
if (!is.null(link.javascript))
link.javascript = paste(hmakeTag("script", language = "JavaScript",
src = link.javascript), collapse = "\n")
if (!is.null(link.css))
link.css = paste(hmakeTag("link", rel = "stylesheet",
type = "text/css", href = link.css), collapse = "\n")
if (!is.null(css))
css = paste(hmakeTag("style", css), collapse = "\n")
head = paste(meta, hmakeTag("title", title), head, link.javascript,
link.css, css, sep = "\n")
head = do.call(hmakeTag, c(list("head", head, newline = TRUE),
head.attributes))
bodyStart = do.call(hmakeTag, c(list("body", NULL), body.attributes))
bodyStart = substr(bodyStart, 1, regexpr("</body>", bodyStart) -
1)
paste(doctype, "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='",
lang, "' lang='", lang, "'>", head, bodyStart,sep = "")
}
makePageEnd = function()
{
"\n</body>\n</html>"
}
#This will be called from the initialize method of HTMLReportRef to create the initial internal DOM representation
startHTMLReport = function(shortName, title = NULL, reportDirectory = ".",
basePath = ".", page = NULL, link.css = NULL, link.javascript = NULL,
overwrite.js=TRUE, handlers, ...)
{
shortName <- sub(".html$", "", shortName)
if(is.null(title))
title <- shortName
jslibenv <- Sys.getenv("REPORTINGTOOLSJSLIB")
csslibenv <- Sys.getenv("REPORTINGTOOLSCSSLIB")
if(jslibenv != "" | csslibenv != "")
{
warning("Use of REPORTINGTOOLSJSLIB and REPORTINGTOOLSCSSLIB environment variables is now deprecated.
Please unset these in your environment.")
}
pageDir = dirname(path(handlers[[1]]))
if(is.null(link.javascript)){
js.libloc <- Sys.getenv("REPORTINGTOOLSJSLIB")
if(js.libloc == ""){
javascript.files <- c(system.file("extdata/jslib/jquery-1.8.0.min.js",
package="ReportingTools"),
system.file("extdata/jslib/jquery.dataTables-1.9.3.js",
package="ReportingTools"),
system.file("extdata/jslib/jquery.dataTables.columnFilter.js",
package="ReportingTools"),
system.file("extdata/jslib/jquery.dataTables.plugins.js",
package="ReportingTools"),
system.file("extdata/jslib/jquery.dataTables.reprise.js",
package="ReportingTools"),
system.file("extdata/jslib/bootstrap.js",
package="ReportingTools")
)
jsDir <- file.path(pageDir,"jslib")
jsDir <- gsub("//+", "/", jsDir)
if(!file.exists(jsDir))
.safe.dir.create(jsDir, recursive=TRUE)
file.copy(javascript.files, jsDir, overwrite=overwrite.js)
javascript.files <- sub(".*extdata/","",javascript.files)
} else {
javascript.files <- paste(js.libloc, c("jquery-1.8.0.min.js",
"jquery.dataTables-1.9.3.js","jquery.dataTables.columnFilter.js",
"jquery.dataTables.plugins.js","jquery.dataTables.reprise.js"),
sep="/")
}
link.javascript <- javascript.files
}
if(is.null(link.css)){
css.libloc <- Sys.getenv("REPORTINGTOOLSCSSLIB")
if(css.libloc == ""){
css.files <- c(
system.file("extdata/csslib/bootstrap.css",
package="ReportingTools"),
system.file("extdata/csslib/reprise.table.bootstrap.css",
package="ReportingTools")
)
cssDir <- (file.path(pageDir,"csslib"))
cssDir <- gsub("//+", "/", cssDir)
.safe.dir.create(cssDir, recursive=TRUE)
file.copy(css.files,cssDir, overwrite=overwrite.js)
css.files <- sub(".*extdata/","",css.files)
css.png.package.dir <- c(system.file("extdata/csslib/images/",
package="ReportingTools"))
css.pngs <- list.files(path=css.png.package.dir)
css.pngs <- paste(css.png.package.dir,css.pngs, sep="/")
cssPngsDir <- (file.path(cssDir, "images"))
.safe.dir.create(cssPngsDir, recursive=TRUE)
file.copy(css.pngs,cssPngsDir)
} else {
css.files <- paste(css.libloc,
c("reset-min.css", "reprise.table.css"), sep="/")
}
link.css <- css.files
}
pagestart = makePageStart(title = title, link.css = link.css,
link.javascript = link.javascript)
node = xmlRoot(htmlParse(paste(pagestart, makePageEnd(), collapse = "\n")))
htitle = hwrite(paste("<h2>",title,"</h2>",sep=""), br=TRUE, class="container", div=TRUE)
body = node[["body"]]
child = xmlRoot(htmlParse(htitle))[["body"]][[1]]
addChildren(body, child )
node
}
JasonHackney/ReportingTools documentation built on Oct. 23, 2023, 9:24 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions startHTMLReport makePageEnd
#lifted the openPage function from hwriter package by Gregoire Pau
makePageStart = function ( title = "Title!", link.javascript = NULL,
link.css = NULL, css = NULL, head = NULL, charset = "utf-8",
lang = "en", head.attributes = NULL, body.attributes = NULL)
{
doctype = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n"
meta = hmakeTag("meta", NULL, `http-equiv` = "Content-Type",
content = paste("text/html; charset=", charset, sep = ""),
newline = FALSE)
if (!is.null(link.javascript))
link.javascript = paste(hmakeTag("script", language = "JavaScript",
src = link.javascript), collapse = "\n")
if (!is.null(link.css))
link.css = paste(hmakeTag("link", rel = "stylesheet",
type = "text/css", href = link.css), collapse = "\n")
if (!is.null(css))
css = paste(hmakeTag("style", css), collapse = "\n")
head = paste(meta, hmakeTag("title", title), head, link.javascript,
link.css, css, sep = "\n")
head = do.call(hmakeTag, c(list("head", head, newline = TRUE),
head.attributes))
bodyStart = do.call(hmakeTag, c(list("body", NULL), body.attributes))
bodyStart = substr(bodyStart, 1, regexpr("</body>", bodyStart) -
1)
paste(doctype, "<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='",
lang, "' lang='", lang, "'>", head, bodyStart,sep = "")
}
makePageEnd = function()
{
"\n</body>\n</html>"
}
#This will be called from the initialize method of HTMLReportRef to create the initial internal DOM representation
startHTMLReport = function(shortName, title = NULL, reportDirectory = ".",
basePath = ".", page = NULL, link.css = NULL, link.javascript = NULL,
overwrite.js=TRUE, handlers, ...)
{
shortName <- sub(".html$", "", shortName)
if(is.null(title))
title <- shortName
jslibenv <- Sys.getenv("REPORTINGTOOLSJSLIB")
csslibenv <- Sys.getenv("REPORTINGTOOLSCSSLIB")
if(jslibenv != "" | csslibenv != "")
{
warning("Use of REPORTINGTOOLSJSLIB and REPORTINGTOOLSCSSLIB environment variables is now deprecated.
Please unset these in your environment.")
}
pageDir = dirname(path(handlers[[1]]))
if(is.null(link.javascript)){
js.libloc <- Sys.getenv("REPORTINGTOOLSJSLIB")
if(js.libloc == ""){
javascript.files <- c(system.file("extdata/jslib/jquery-1.8.0.min.js",
package="ReportingTools"),
system.file("extdata/jslib/jquery.dataTables-1.9.3.js",
package="ReportingTools"),
system.file("extdata/jslib/jquery.dataTables.columnFilter.js",
package="ReportingTools"),
system.file("extdata/jslib/jquery.dataTables.plugins.js",
package="ReportingTools"),
system.file("extdata/jslib/jquery.dataTables.reprise.js",
package="ReportingTools"),
system.file("extdata/jslib/bootstrap.js",
package="ReportingTools")
)
jsDir <- file.path(pageDir,"jslib")
jsDir <- gsub("//+", "/", jsDir)
if(!file.exists(jsDir))
.safe.dir.create(jsDir, recursive=TRUE)
file.copy(javascript.files, jsDir, overwrite=overwrite.js)
javascript.files <- sub(".*extdata/","",javascript.files)
} else {
javascript.files <- paste(js.libloc, c("jquery-1.8.0.min.js",
"jquery.dataTables-1.9.3.js","jquery.dataTables.columnFilter.js",
"jquery.dataTables.plugins.js","jquery.dataTables.reprise.js"),
sep="/")
}
link.javascript <- javascript.files
}
if(is.null(link.css)){
css.libloc <- Sys.getenv("REPORTINGTOOLSCSSLIB")
if(css.libloc == ""){
css.files <- c(
system.file("extdata/csslib/bootstrap.css",
package="ReportingTools"),
system.file("extdata/csslib/reprise.table.bootstrap.css",
package="ReportingTools")
)
cssDir <- (file.path(pageDir,"csslib"))
cssDir <- gsub("//+", "/", cssDir)
.safe.dir.create(cssDir, recursive=TRUE)
file.copy(css.files,cssDir, overwrite=overwrite.js)
css.files <- sub(".*extdata/","",css.files)
css.png.package.dir <- c(system.file("extdata/csslib/images/",
package="ReportingTools"))
css.pngs <- list.files(path=css.png.package.dir)
css.pngs <- paste(css.png.package.dir,css.pngs, sep="/")
cssPngsDir <- (file.path(cssDir, "images"))
.safe.dir.create(cssPngsDir, recursive=TRUE)
file.copy(css.pngs,cssPngsDir)
} else {
css.files <- paste(css.libloc,
c("reset-min.css", "reprise.table.css"), sep="/")
}
link.css <- css.files
}
pagestart = makePageStart(title = title, link.css = link.css,
link.javascript = link.javascript)
node = xmlRoot(htmlParse(paste(pagestart, makePageEnd(), collapse = "\n")))
htitle = hwrite(paste("<h2>",title,"</h2>",sep=""), br=TRUE, class="container", div=TRUE)
body = node[["body"]]
child = xmlRoot(htmlParse(htitle))[["body"]][[1]]
addChildren(body, child )
node
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.