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