1
###########################################################################/**
2
# @RdocFunction parseVignette
3
#
4
# @title "Parses an Rnw file"
5
#
6
# \description{
7
#  @get "title".
8
# }
9
#
10
# @synopsis
11
#
12
# \arguments{
13
#   \item{pathname}{The Rnw file to be parsed.}
14
#   \item{commentPrefix}{A regular expression specifying the prefix
15
#     pattern of vignette comments.}
16
#   \item{final}{If @TRUE, the output PDF or HTML file is also located.}
17
#   \item{source}{If @TRUE, the output R source code file is also located.}
18
#   \item{maxLines}{The maximum number of lines to scan.}
19
#   \item{...}{Not used.}
20
# }
21
#
22
# \value{
23
#   Returns a named @list or NULL if a non-vignette.
24
# }
25
#
26
# @author
27
#
28
# @keyword file
29
# @keyword IO
30
# @keyword internal
31
#*/###########################################################################
32
parseVignette <- function(pathname, commentPrefix="^[ \t]*%[ \t]*", final=FALSE, source=FALSE, maxLines=-1L, ...) {
33
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
34
  # Local functions
35
  # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
36 0
  findOutput <- function(pathname, pattern) {
37 0
     path <- dirname(pathname)
38 0
     filename <- basename(pathname)
39 0
     ext <- gsub(".*[.]([^.]*)$", "\\1", filename)
40

41
     # All available output files
42 0
     filenames <- list.files(path=path, pattern=pattern)
43 0
     fullnames <- gsub("[.][^.]*$", "", filenames)
44 0
     patterns <- sprintf("^%s.*[.]%s$", fullnames, ext)
45 0
     keep <- (unlist(lapply(patterns, FUN=regexpr, filename), use.names=FALSE) != -1L)
46 0
     filenames <- filenames[keep]
47 0
     if (length(filenames) == 0L) return(NULL)
48

49
     # Order by decreasing filename lengths
50 0
     o <- order(nchar(filenames), decreasing=TRUE)
51 0
     filenames <- filenames[o]
52 0
     file.path(path, filenames)
53
  }
54

55

56 0
  if (!file.exists(pathname)) {
57 0
    stop("Cannot build vignette. File not found: ", pathname)
58
  }
59

60 0
  bfr <- readLines(pathname, warn=FALSE, n=maxLines)
61

62
  # Parse for "\Vignette" options
63 0
  pattern <- sprintf("%s\\\\Vignette(.*)\\{(.*)\\}", commentPrefix)
64 0
  rows <- which(regexpr(pattern, bfr) != -1L)
65 0
  bfr <- bfr[rows]
66

67
  # Nothing found?
68 0
  if (length(bfr) == 0L) {
69 0
    return(NULL)
70
  }
71

72
  # If the first entry is not among the first 20 rows, assume the ones
73
  # founds are part of the text document such entries rather than entries
74
  # used for the vignette itself.
75 0
  if (rows[1L] > 20L) {
76 0
    return(NULL)
77
  }
78

79 0
  opts <- grep(pattern, bfr, value=TRUE)
80 0
  keys <- gsub(pattern, "\\1", opts)
81 0
  values <- gsub(pattern, "\\2", opts)
82 0
  names(values) <- keys
83 0
  opts <- as.list(values)
84

85
  # Drop duplicated entries, assuming the first ones are the intended
86
  # ones.  The extra ones may happen when a vignette documents how to
87
  # use %\\VignetteNnn{} markup.
88 0
  keep <- !duplicated(names(opts))
89 0
  opts <- opts[keep]
90

91
  # No %\VignetteIndexEntry{}?
92 0
  if (!is.element("IndexEntry", names(values))) {
93 0
    return(NULL)
94
  }
95

96 0
  vign <- c(list(pathname=pathname), opts)
97

98

99
  # Look for a generated PDF or HTML file?
100 0
  if (final) {
101 0
     output <- findOutput(pathname, pattern="[.](pdf|PDF|html|HTML)$")
102 0
     if (length(output) == 0L) {
103 0
       stop("Failed to located PDF or HTML output file for vignette: ", pathname)
104 0
     } else if (length(output) > 1L) {
105 0
       stop("Located more than one PDF or HTML output file for vignette: ", pathname)
106
     }
107 0
     vign$final <- output
108
  }
109

110
  # Look for a generated R source code file?
111 0
  if (source) {
112 0
     output <- findOutput(pathname, pattern="[.][rRsS]$")
113 0
     if (length(output) > 1L) {
114 0
       output <- output[1L]
115
     }
116 0
     vign$source <- output
117
  }
118

119
  # Assert unique entries
120 0
  names <- names(vign)
121 0
  dups <- names[duplicated(names)]
122 0
  if (length(dups) > 0L) {
123 0
    throw("Duplicated entries detected: ", paste(dups, collapse=", "))
124
  }
125

126 0
  vign
127
} # parseVignette()
128

129

130

131
###########################################################################/**
132
# @RdocFunction parseVignettes
133
#
134
# @title "Locates and parses all vignettes"
135
#
136
# \description{
137
#  @get "title".
138
# }
139
#
140
# @synopsis
141
#
142
# \arguments{
143
#   \item{path}{The directory where to search for vignettes.}
144
#   \item{pattern}{Filename pattern to locate vignettes.}
145
#   \item{...}{Additional arguments passed to @see "parseVignette".}
146
#   \item{drop}{A @vector of filename patterns of vignette sources
147
#    to be ignored.}
148
# }
149
#
150
# \value{
151
#   Returns a @list where each element corresponds to an
152
#   identified vignette source file.  A file is considered to be
153
#   a vignette source file if it has \code{\\Vignette.*\{\}} markups
154
#   in the top 50 lines.
155
#   Each such vignette element consists of a named @list with
156
#   the parse \code{\\Vignette.*\{\}} information.
157
# }
158
#
159
# @author
160
#
161
# @keyword file
162
# @keyword IO
163
# @keyword internal
164
#*/###########################################################################
165
parseVignettes <- function(path=".", pattern="[.][^.~]*$", ..., drop="^dummy.tex$") {
166 0
  pathnames <- list.files(path=path, pattern=pattern, full.names=TRUE)
167

168
  # Ignore certain files, e.g. "^dummy.Rnw$"?
169 0
  if (length(drop) > 0L) {
170 0
    filenames <- basename(pathnames)
171 0
    excl <- rep(FALSE, times=length(filenames))
172 0
    for (pattern in drop) {
173 0
      excl <- excl | (regexpr(pattern, filenames) != -1L)
174
    }
175 0
    pathnames <- pathnames[!excl]
176
  }
177

178 0
  vigns <- list()
179 0
  for (kk in seq_along(pathnames)) {
180 0
    pathname <- pathnames[kk]
181 0
    vign <- parseVignette(pathname, ...)
182 0
    if (length(vign) == 0L)
183 0
       next
184 0
    vigns[[pathname]] <- vign
185
  }
186

187 0
  vigns
188
} # parseVignettes()
189

190

191

192
###########################################################################/**
193
# @RdocFunction buildNonSweaveVignette
194
#
195
# @title "Builds a non-Sweave Rnw vignette"
196
#
197
# \description{
198
#  @get "title".
199
# }
200
#
201
# @synopsis
202
#
203
# \arguments{
204
#   \item{pathname}{The vignette file to be built.}
205
#   \item{...}{Not used.}
206
# }
207
#
208
# \value{
209
#   Returns (invisibly) a named @list.
210
# }
211
#
212
# @author
213
#
214
# @keyword file
215
# @keyword IO
216
# @keyword internal
217
#*/###########################################################################
218
buildNonSweaveVignette <- function(vign, envir=new.env(), ...) {
219
  # Local functions
220 0
  SweaveStangle <- function(file, ...) {
221 0
    pathnameR <- utils::Sweave(file, ...)
222 0
    utils::Stangle(file, ...)
223 0
    pathnameR
224
  }
225

226
  # A filename?
227 0
  if (is.character(vign)) {
228 0
    pathname <- vign
229 0
    vign <- parseVignette(pathname, ...)
230
  }
231

232 0
  pathname <- vign$pathname
233

234
  # Load required packages
235 0
  if (!is.null(vign$Depends)) {
236 0
    pkgNames <- vign$Depends
237 0
    pkgNames <- unlist(strsplit(pkgNames, split=",", fixed=TRUE), use.names=FALSE)
238 0
    pkgNames <- gsub("(^[ \t]*|[ \t]*$)", "", pkgNames)
239 0
    for (pkgName in pkgNames) {
240 0
      library(pkgName, character.only=TRUE)
241
    }
242
  }
243

244
  # Build vignette according to \VignetteBuild{} command
245 0
  if (!is.null(cmd <- vign$Engine) && nchar(cmd) > 0L) {
246
    # Retrieve the "engine" according to \VignetteEngine{} expression
247 0
    res <- get(cmd, envir=envir, mode="function")
248 0
  } else if (!is.null(cmd <- vign$Build) && nchar(cmd) > 0L) {
249
    # Parse \VignetteBuild{} expression
250 0
    tryCatch({
251 0
      expr <- parse(text=cmd)
252 0
    }, error = function(ex) {
253 0
      stop(sprintf("Syntax error in \\VignetteBuild{%s}: %s", cmd, ex$message))
254
    })
255

256
    # Evaluate \VignetteBuild{} expression
257 0
    res <- eval(expr)
258
  } else {
259
     # If not specified, assume Sweave
260 0
     res <- SweaveStangle
261
  }
262

263
  # Was a function specified?
264 0
  if (is.function(res)) {
265 0
    fcn <- res
266 0
    res <- fcn(pathname)
267
  }
268

269 0
  invisible(res)
270
} # buildNonSweaveVignette()
271

272

273

274
###########################################################################/**
275
# @RdocFunction buildNonSweaveVignettes
276
#
277
# @title "Builds all non-Sweave Rnw vignette"
278
#
279
# \description{
280
#  @get "title".
281
# }
282
#
283
# @synopsis
284
#
285
# \arguments{
286
#   \item{path}{The directory where to search for non-Sweave vignettes.}
287
#   \item{pattern}{Filename pattern to locate non-Sweave vignettes.}
288
#   \item{...}{Additional arguments passed to @see "buildNonSweaveVignette".}
289
# }
290
#
291
# \value{
292
#   Returns (invisibly) a named @list with elements of what
293
#   the vignette builder returns.
294
# }
295
#
296
# @author
297
#
298
# \seealso{
299
#   To build vignette, see @see "buildNonSweaveVignette".
300
# }
301
#
302
# @keyword file
303
# @keyword IO
304
# @keyword internal
305
#*/###########################################################################
306
buildNonSweaveVignettes <- function(...) {
307 0
  vigns <- parseVignettes(...)
308 0
  if (length(vigns) > 0L) {
309 0
     envir <- new.env()
310 0
     path <- system.file("doc", "templates", package="R.rsp")
311 0
     path <- c(path, dirname(vigns[[1L]]$pathname))
312 0
     pathnames <- file.path(path, "enginesMap.R")
313 0
     pathnames <- pathnames[file_test("-f", pathnames)]
314 0
     for (pathname in pathnames) {
315 0
       expr <- parse(pathname)
316 0
       eval(expr, envir=envir)
317
     }
318
  }
319 0
  for (kk in seq_along(vigns)) {
320 0
    vign <- vigns[[kk]]
321 0
    vign$result <- buildNonSweaveVignette(vign, envir=envir, ...)
322 0
    vigns[[kk]] <- vign
323
  }
324 0
  invisible(vigns)
325
} # buildNonSweaveVignettes()
326

327

328

329
###########################################################################/**
330
# @RdocFunction buildNonSweaveTexToPdf
331
#
332
# @title "Compiles all TeX files into PDFs"
333
#
334
# \description{
335
#  @get "title", unless already done.
336
# }
337
#
338
# @synopsis
339
#
340
# \arguments{
341
#   \item{path}{The directory where to search for TeX files.}
342
#   \item{pattern}{Filename pattern to locate TeX files.}
343
#   \item{...}{Additional arguments passed to @see "tools::texi2pdf".}
344
# }
345
#
346
# \value{
347
#   Returns (invisibly) a named @list of results.
348
# }
349
#
350
# @author
351
#
352
# @keyword file
353
# @keyword IO
354
# @keyword internal
355
#*/###########################################################################
356
buildNonSweaveTexToPdf <- function(path=".", pattern="[.](tex|ltx)$", ...) {
357 0
  pathnames <- list.files(path=path, pattern=pattern, full.names=TRUE)
358

359
  # Ignore dummy.tex (which is created by R from dummy.Rnw just before make)
360 0
  keep <- !is.element(basename(pathnames), c("dummy.tex"))
361 0
  pathnames <- pathnames[keep]
362

363 0
  res <- list()
364 0
  for (pathname in pathnames) {
365 0
    pathnamePDF <- sprintf("%s.pdf", gsub(pattern, "", pathname))
366 0
    if (!isFile(pathnamePDF)) {
367 0
       res[[pathname]] <- texi2pdf(file=pathname, ...)
368
    }
369
  }
370 0
  invisible(res)
371
} # buildNonSweaveTexToPdf()
372

373

374
###########################################################################/**
375
# @RdocFunction buildPkgIndexHtml
376
#
377
# @title "Builds a package index HTML file"
378
#
379
# \description{
380
#  @get "title", iff missing.
381
# }
382
#
383
# @synopsis
384
#
385
# \arguments{
386
#   \item{...}{Not used.}
387
# }
388
#
389
# \value{
390
#   Returns (invisibly) the absolute pathname to the built index.html file.
391
#   If an index.html file already exists, nothing is done and @NULL
392
#   is returned.
393
# }
394
#
395
# @author
396
#
397
# @keyword file
398
# @keyword IO
399
# @keyword internal
400
#*/###########################################################################
401
buildPkgIndexHtml <- function(...) {
402
  # Nothing to do?
403 0
  if (file.exists("index.html")) {
404 0
    return(NULL)
405
  }
406

407 0
  library("R.rsp")
408

409 0
  filename <- "index.html.rsp"
410 0
  if (!file.exists(filename)) {
411
    # If not custom index.html.rsp exists, use the one of the R.rsp package
412 0
    path <- system.file("doc/templates", package="R.rsp")
413 0
    pathname <- file.path(path, filename)
414 0
    file.copy(pathname, to=".")
415 0
    on.exit({
416 0
      file.remove(filename)
417
    })
418
  }
419

420
  # Sanity check
421 0
  stop_if_not(file.exists(filename))
422

423
  # Build index.html
424 0
  rfile(filename)
425
} # buildPkgIndexHtml()

Read our documentation on viewing source code .

Loading