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 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394
|
###########################################################################/**
# @RdocFunction rspWeave
# @alias asisWeave
#
# @title "A weave function for RSP documents"
#
# \description{
# @get "title".
# This function is for RSP what @see "utils::Sweave" is for Sweave documents.
# }
#
# @synopsis
#
# \arguments{
# \item{file}{The file to be weaved.}
# \item{...}{Not used.}
# \item{postprocess}{If @TRUE, the compiled document is also post
# processed, if possible.}
# \item{clean}{If @TRUE, intermediate files are removed, otherwise not.}
# \item{quiet}{If @TRUE, no verbose output is generated.}
# \item{envir}{The @environment where the RSP document is
# parsed and evaluated.}
# \item{.engineName}{Internal only.}
# }
#
# \value{
# Returns the absolute pathname of the generated RSP product.
# The generated RSP product is postprocessed, if possible.
# }
#
# @author
#
# \seealso{
# @see "rspTangle"
# }
#
# @keyword file
# @keyword IO
# @keyword internal
#*/###########################################################################
rspWeave <- function(file, ..., postprocess=TRUE, clean=TRUE, quiet=FALSE, envir=new.env(), .engineName="rsp") {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# WORKAROUND: 'R CMD build' seems to ignore the %\VignetteEngine{<engine>}
# markup for R (>= 3.0.0 && <= 3.0.1 patched r63905) and only go by the
# filename pattern. If this is the case, then the incorrect engine may
# have been called. Below we check for this and call the proper one if
# that is the case.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (.engineName == "rsp") {
weave <- .getRspWeaveTangle(file=file, what="weave")
} else {
weave <- NULL
}
# If no problems, use the default rfile() weaver.
if (is.null(weave)) {
weave <- function(..., quiet=FALSE) {
rfile(..., workdir=".", postprocess=postprocess, clean=clean, verbose=!quiet)
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Weave!
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
res <- weave(file, ..., quiet=quiet, envir=envir)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Cleanup, i.e. remove intermediate RSP files, e.g. Markdown and TeX?
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (postprocess && clean) {
tmp <- file_path_sans_ext(basename(file))
if (tmp != basename(res) && tolower(file_ext(file)) == "rsp") {
if (file_test("-f", tmp)) file.remove(tmp)
}
}
# DEBUG: Store generated file? /HB 2013-09-17
path <- Sys.getenv("RSP_DEBUG_PATH")
if (nchar(path) > 0L) {
R.utils::copyFile(res, file.path(path, basename(res)), overwrite=TRUE)
}
invisible(res)
} # rspWeave()
###########################################################################/**
# @RdocFunction rspTangle
# @alias asisTangle
#
# @title "A tangle function for RSP documents"
#
# \description{
# @get "title".
# This function is for RSP what @see "utils::Stangle" is for Sweave documents.
# }
#
# @synopsis
#
# \arguments{
# \item{file}{The file to be tangled.}
# \item{...}{Not used.}
# \item{envir}{The @environment where the RSP document is parsed.}
# \item{pattern}{A filename pattern used to identify the name.}
# }
#
# \value{
# Returns the absolute pathname of the generated R source code file.
# }
#
# @author
#
# \seealso{
# @see "rspWeave"
# }
#
# @keyword file
# @keyword IO
# @keyword internal
#*/###########################################################################
rspTangle <- function(file, ..., envir=new.env(), pattern="(|[.][^.]*)[.]rsp$") {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'file':
file <- Arguments$getReadablePathname(file)
# Setup output R file
workdir <- "."
filename <- basename(file)
fullname <- gsub(pattern, "", filename)
filenameR <- sprintf("%s.R", fullname)
pathnameR <- Arguments$getWritablePathname(filenameR, path=workdir)
pathnameR <- getAbsolutePath(pathnameR)
# Translate RSP document to RSP code script
rcode <- rcode(file=file, output=RspSourceCode(), ...)
# Check if tangle is disabled by the vignette
tangle <- getMetadata(rcode, "tangle")
tangle <- tolower(tangle)
tangle <- (length(tangle) == 0L) || !is.element(tangle, c("false", "no"))
if (tangle) {
rcode <- tangle(rcode)
} else {
## As of R (> 3.3.2) all vignettes have to output at least one tangled file
rcode <- NULL
}
# Create header
hdr <- NULL
hdr <- c(hdr, "This 'tangle' R script was created from an RSP document.")
hdr <- c(hdr, sprintf("RSP source document: '%s'", file))
md <- getMetadata(rcode, local=FALSE)
for (key in names(md)) {
value <- md[[key]]
value <- gsub("\n", "\\n", value, fixed=TRUE)
value <- gsub("\r", "\\r", value, fixed=TRUE)
hdr <- c(hdr, sprintf("Metadata '%s': '%s'", key, value))
}
# Turn into header comments and prepend to code
hdr <- sprintf("### %s", hdr)
ruler <- paste(rep("#", times=75L), collapse="")
rcode <- c(ruler, hdr, ruler, "", rcode)
# Write R code
writeLines(rcode, con=pathnameR)
invisible(pathnameR)
} # rspTangle()
asisWeave <- function(file, ...) {
output <- file_path_sans_ext(basename(file))
# Make sure the output vignette exists
if (!isFile(output)) {
# It could be that we're here because 'R CMD check' runs the
# 're-building of vignette outputs' step. Then the output
# file has already been moved to inst/doc/. If so, grab it
# from there instead.
outputS <- file.path("..", "inst", "doc", output)
if (isFile(outputS)) {
file.copy(outputS, output, overwrite=TRUE)
output <- outputS
} else {
path <- Sys.getenv("RSP_DEBUG_PATH")
if (nchar(path) > 0L) {
msg <- list(file=file, output=output, pwd=getwd(), files=dir())
local({
sink(file.path(path, "R.rsp.DEBUG"))
on.exit(sink())
print(msg)
})
}
throw("No such output file: ", output)
}
}
# Update the timestamp of the output file
# (otherwise tools::buildVignettes() won't detect it)
touchFile(output)
# DEBUG: Store generated file? /HB 2013-09-17
path <- Sys.getenv("RSP_DEBUG_PATH")
if (nchar(path) > 0L) {
copyFile(output, file.path(path, basename(output)), overwrite=TRUE)
}
output
} # asisWeave()
asisTangle <- function(file, ..., pattern="(|[.][^.]*)[.]asis$") {
# Setup output R file
workdir <- "."
filename <- basename(file)
fullname <- gsub(pattern, "", filename)
filenameR <- sprintf("%s.R", fullname)
pathnameR <- Arguments$getWritablePathname(filenameR, path=workdir)
pathnameR <- getAbsolutePath(pathnameR)
cat(sprintf("### This is an R script tangled from '%s'\n", filename), file=pathnameR)
invisible(pathnameR)
} # asisTangle()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# WORKAROUND: 'R CMD build' seems to ignore the %\VignetteEngine{<engine>}
# markup for R (>= 3.0.0 && <= 3.0.1 patched r63905) and only go by the
# filename pattern. If this is the case, then the incorrect engine may
# have been called. Below we check for this and call the proper one if
# that is the case.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
.getRspWeaveTangle <- function(file, ..., what=c("weave", "tangle")) {
# Are we using an R version that does not acknowledge the
# %\VignetteEngine{<engine>} markup?
rver <- getRversion()
if (rver < "3.0.0" || rver >= "3.0.2") {
return(NULL) # Nope
}
# Fixed in R 3.0.1 patched (2013-09-11 r63906)
rrev <- paste(R.version[["svn rev"]], "", sep="")
if (rrev >= "63906") {
return(NULL) # Nope
}
# If SVN revision is not recorded, then do one last check...
ns <- getNamespace("tools")
if (exists("engineMatches", envir=ns, mode="function")) {
return(NULL) # Nope
}
# Does the vignette specify a particular vignette engine?
content <- readLines(file, warn=FALSE)
meta <- .parseRVignetteMetadata(content)
engineName <- meta$engine
if (is.null(engineName)) {
return(NULL) # Nope
}
# Yes, it's possible that we have ran the incorrect vignette engine...
# Find the intended vignette engine
engine <- tryCatch({
vignetteEngine <- get("vignetteEngine", envir=ns)
vignetteEngine(engineName, package="R.rsp")
}, error = function(engine) NULL)
if (is.null(engine)) {
throw(sprintf("No such vignette engine: %%\\VignetteEngine{%s}", engineName))
}
# Was the wrong vignette engine used?
if (engine$name == "rsp") {
return(NULL) # Nope
}
# Assert that the filename pattern is correct
patterns <- engine$pattern
if (length(patterns > 0L)) {
ok <- any(sapply(patterns, FUN=regexpr, basename(file)) != -1L)
if (!ok) {
throw(sprintf("The filename pattern (%s) of the intended vignette engine ('%s::%s') does not match the file ('%s') to be processed.", paste(sQuote(patterns), collapse=", "), engine$package, engine$name, basename(file)))
}
}
# Process the vignette using the intended vignette engine
engine[[what]]
} # .getRspWeaveTangle()
# The weave function of vignette engine 'md.rsp+knitr:pandoc'
`.weave_md.rsp+knitr:pandoc` <- function(file, ..., envir=new.env()) {
# Process *.md.rsp to *.md
md <- rspWeave(file, ..., postprocess=FALSE, envir=envir,
.engineName="R.rsp::md.rsp+knitr:pandoc")
# Is Pandoc and DZSlides fully supported?
dzslides <- isCapableOf(R.rsp, "pandoc (>= 1.9.2)")
if (dzslides) {
# Pandoc *.md to *.html
format <- Sys.getenv("R.rsp/pandoc/args/format", "html")
use("knitr", quietly=TRUE)
# To please R CMD check
pandoc <- NULL; rm(list="pandoc")
suppressMessages({
html <- pandoc(md, format=format)
})
## WORKAROUND: Did knitr::pandoc() append '_utf8' to the full name?
html0 <- file_path_sans_ext(basename(html))
if (grepl("_utf8$", html0)) {
html1 <- gsub("_utf8.", ".", html, fixed=TRUE)
renameFile(html, html1)
html <- html1
}
html <- RspFileProduct(html)
} else {
if (isTRUE(Sys.getenv("RSP_REQ_PANDOC"))) {
# Silently ignore if 'R CMD check' is "re-building of vignette outputs"
pathname <- getAbsolutePath(md)
path <- dirname(pathname)
parts <- strsplit(path, split=c("/", "\\"), fixed=TRUE)
parts <- unlist(parts, use.names=FALSE)
vignetteTests <- any(parts == "vign_test")
if (vignetteTests) {
throw("External 'pandoc' executable is not available on this system: ", pathname)
}
}
warning("Could not find external executable 'pandoc' v1.9.2 or newer on this system while running 'R CMD check' on the vignettes. Will run the default post-processor instead: ", basename(md))
# If running R CMD check, silently accept that Pandoc is not
# available. Instead, just run it through the regular
# Markdown to HTML postprocessor.
html <- process(md)
} # if (dzslides)
# Remove *.md
file.remove(md)
invisible(html)
} # `.weave_md.rsp+knitr:pandoc`()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# REGISTER VIGNETTE ENGINES
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
.registerVignetteEngines <- function(pkgname) {
# Are vignette engines supported?
if (getRversion() < "3.0.0") return() # Nope!
# Register vignette engines
vignetteEngine <- get("vignetteEngine", envir=asNamespace("tools"))
# RSP engine
vignetteEngine("rsp", package=pkgname,
pattern="[.][^.]*[.]rsp$",
weave=rspWeave,
tangle=rspTangle
)
# "asis" engine
vignetteEngine("asis", package=pkgname,
pattern="[.](pdf|html)[.]asis$",
weave=asisWeave,
tangle=asisTangle
)
# TeX engine
vignetteEngine("tex", package=pkgname,
pattern="[.](tex|ltx)$",
weave=rspWeave,
tangle=function(file, ..., pattern="[.](tex|ltx)$") asisTangle(file, ..., pattern=pattern)
)
# Markdown engine
vignetteEngine("md", package=pkgname,
pattern="[.]md$",
weave=rspWeave,
tangle=function(file, ..., pattern="[.]md$") asisTangle(file, ..., pattern=pattern)
)
# Markdown RSP + knitr::pandoc engine (non-offical trial version)
vignetteEngine("md.rsp+knitr:pandoc", package=pkgname,
pattern="[.]md[.]rsp$",
weave=`.weave_md.rsp+knitr:pandoc`,
tangle=rspTangle
)
} # .registerVignetteEngines()
|