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()

Read our documentation on viewing source code .

Loading