Nothing
# Vignette generation related functions
#
# Author: Renaud Gaujoux
# Creation: 25 Apr 2012
###############################################################################
#' @include packages.R
NULL
rnw_message <- function(...) message("# ", ...)
#' Identifying Sweave Run
#'
#' Tells if the current code is being executed within a Sweave document.
#'
#' @return \code{TRUE} or \code{FALSE}
#' @export
#'
#' @examples
#'
#' # Not in a Sweave document
#' inSweave()
#'
#' # Within a Sweave document
#'
inSweave <- function(){
# in.sweave <- FALSE
if ((n.parents <- length(sys.parents())) >= 3) {
for (i in seq_len(n.parents) - 1) {
if ("chunkopts" %in% ls(envir = sys.frame(i))) {
chunkopts = get("chunkopts", envir = sys.frame(i))
if (all(c("prefix.string", "label") %in% names(chunkopts))) {
# in.sweave <- TRUE
return(TRUE)
break
}
}
}
}
FALSE
}
#' Generate a Fake Vignette
#'
#' @param src original Sweave file
#' @param out output file
#' @param PACKAGE package name where to look the source vignette
#'
#' @return No return value, called to create a vignette file.
#' @export
makeFakeVignette <- function(src, out, PACKAGE=NULL){
# interpret template within the package directory
if( !is.null(PACKAGE) ){
src <- str_c(, src)
}
if( identical(normalizePath(dirname(src)), normalizePath(dirname(out))) ){
cat("# NOTE: skipped fake vignette [source in root directory]\n")
return(invisible())
}
# read in template file
l <- readLines(src)
# extract %\Vignette commands
vign <- l[grep("^%\\s*\\\\Vignette", l)]
# write output file
cat(c("\\documentclass[10pt]{article}"
, vign
, "\\usepackage{url}\n\\usepackage[colorlinks]{hyperref}\n\n\\begin{document}\n\\end{document}")
, file=out, sep="\n");
}
#' LaTeX Utilities for Vignettes
#'
#' \code{latex_preamble} outputs/returns LaTeX command definitions to
#' be put in the preamble of vignettes.
#'
#' Argument \code{PACKAGE} is not required for \code{latex_preamble}, but must
#' be correctly specified to ensure \code{biblatex=TRUE} generates the correct
#' bibliography command.
#'
#' @param R logical that indicate if general R commands should be added
#' (e.g. package names, inline R code format commands)
#' @param CRAN logical that indicate if general CRAN commands should be added
#' (e.g. CRAN package citations)
#' @param Bioconductor logical that indicate if general Bioconductor commands
#' should be added (e.g. Bioc package citations)
#' @param GEO logical that indicate if general GEOmnibus commands should be added
#' (e.g. urls to GEO datasets)
#' @param ArrayExpress logical that indicate if general ArrayExpress commands
#' should be added (e.g. urls to ArrayExpress datasets)
#' @param biblatex logical that indicates if a \code{\\bibliography} command
#' should be added to include references from the package's REFERENCES.bib file.
#'
#' @param only a logical that indicates if the only the commands whose
#' dedicated argument is not missing should be considered.
#' @param file connection where to print. If \code{NULL} the result is returned
#' silently.
#'
#' @return A character string or nothing and output the command to stdout.
#'
#' @import stringr
#' @export
#' @rdname latex
#' @examples
#'
#' latex_preamble()
#' latex_preamble(R=TRUE, only=TRUE)
#' latex_preamble(R=FALSE, CRAN=FALSE, GEO=FALSE)
#' latex_preamble(GEO=TRUE, only=TRUE)
#'
latex_preamble <- function(PACKAGE, R=TRUE, CRAN=TRUE, Bioconductor=TRUE
, GEO=TRUE, ArrayExpress=TRUE, biblatex=FALSE, only=FALSE, file=''){
cmd <- "%%%% PKGMAKER COMMANDS %%%%%%
\\usepackage{xspace}
"
inc <- function(arg){
e <- parent.frame()
(!only || eval(substitute(hasArg(arg), list(arg=substitute(arg))), e)) && arg
}
if( inc(R) ){
cmd <- c(cmd,
"% R
\\let\\proglang=\\textit
\\let\\code=\\texttt
\\providecommand{\\Rcode}{\\code}
\\providecommand{\\pkgname}[1]{\\textit{#1}\\xspace}
\\providecommand{\\Rpkg}[1]{\\pkgname{#1} package\\xspace}
\\providecommand{\\citepkg}[1]{\\cite{#1}}
")
}
if( inc(CRAN) ){
cmd <- c(cmd,
"% CRAN
\\providecommand{\\CRANurl}[1]{\\url{https://cran.r-project.org/package=#1}}
%% CRANpkg
\\makeatletter
\\def\\CRANpkg{\\@ifstar\\@CRANpkg\\@@CRANpkg}
\\def\\@CRANpkg#1{\\href{https://cran.r-project.org/package=#1}{\\pkgname{#1}}\\footnote{\\CRANurl{#1}}}
\\def\\@@CRANpkg#1{\\href{https://cran.r-project.org/package=#1}{\\pkgname{#1}} package\\footnote{\\CRANurl{#1}}}
\\makeatother
%% citeCRANpkg
\\makeatletter
\\def\\citeCRANpkg{\\@ifstar\\@citeCRANpkg\\@@citeCRANpkg}
\\def\\@citeCRANpkg#1{\\CRANpkg{#1}\\cite*{Rpackage:#1}}
\\def\\@@citeCRANpkg#1{\\CRANpkg{#1}~\\cite{Rpackage:#1}}
\\makeatother
\\providecommand{\\CRANnmf}{\\href{https://cran.r-project.org/package=NMF}{CRAN}}
\\providecommand{\\CRANnmfURL}{\\url{https://cran.r-project.org/package=NMF}}
")
}
if( inc(Bioconductor) ){
cmd <- c(cmd,
"% Bioconductor
\\providecommand{\\BioCurl}[1]{\\url{http://www.bioconductor.org/packages/release/bioc/html/#1.html}}
\\providecommand{\\BioCpkg}[1]{\\href{http://www.bioconductor.org/packages/release/bioc/html/#1.html}{\\pkgname{#1}} package\\footnote{\\BioCurl{#1}}}
\\providecommand{\\citeBioCpkg}[1]{\\BioCpkg{#1}~\\cite{Rpackage:#1}}
% Bioconductor annotation
\\providecommand{\\BioCAnnurl}[1]{\\url{http://www.bioconductor.org/packages/release/data/annotation/html/#1.html}}
\\providecommand{\\BioCAnnpkg}[1]{\\href{http://www.bioconductor.org/packages/release/data/annotation/html/#1.html}{\\Rcode{#1}} annotation package\\footnote{\\BioCAnnurl{#1}}}
\\providecommand{\\citeBioCAnnpkg}[1]{\\BioCAnnpkg{#1}~\\cite{Rpackage:#1}}
")
}
if( inc(GEO) ){
cmd <- c(cmd,
"% GEO
\\providecommand{\\GEOurl}[1]{\\href{http://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=#1}{#1}\\xspace}
\\providecommand{\\GEOhref}[1]{\\GEOurl{#1}\\footnote{\\url{http://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=#1}}}
")
}
if( inc(ArrayExpress) ) cmd <- c(cmd,
"% ArrayExpress
\\providecommand{\\ArrayExpressurl}[1]{\\href{http://www.ebi.ac.uk/arrayexpress/experiments/#1}{#1}\\xspace}
\\providecommand{\\ArrayExpresshref}[1]{\\ArrayExpressurl{#1}\\footnote{\\url{http://www.ebi.ac.uk/arrayexpress/experiments/#1}}}
")
if( biblatex ){
if( missing(PACKAGE) )
stop("Argument `PACKAGE` is required when specifying `biblatex=TRUE`.")
cmd <- c(cmd, latex_bibliography(PACKAGE, file=NULL))
}
# output or return commands
cmd <- c(cmd, "%%%% END: PKGMAKER COMMANDS %%%%%%\n")
cmd <- str_c(cmd, collapse="\n")
if( !is.null(file) ) cat(cmd, file = file, sep='')
else cmd
}
#' @describeIn latex \code{latex_bibliography} prints or return a LaTeX command that includes a
#' package bibliography file if it exists.
#'
#' @param PACKAGE package name
#'
#' @export
#'
latex_bibliography <- function(PACKAGE, file=''){
rpkg.bib <- "%\\bibliography{Rpackages}\n"
cmd <- rpkg.bib
# get REFERENCES.bib file
reffile <- packageReferenceFile(PACKAGE=PACKAGE)
if( is.file(reffile) ){
cmd <- paste0(cmd, "\\bibliography{", gsub("\\.bib$", "", reffile), "}\n")
}
# add post-processing knit hook
if( !requireNamespace('knitr', quietly = TRUE) )
stop("Package 'knitr' is required to run latex_bibliography.")
knitr::knit_hooks$set(document = function(x){
# write bibfile if necessary
if( length(pkgs <- parsePackageCitation(x)) ){
# write bibfile
write.pkgbib(gsub("^Rpackage:", '', pkgs), file='Rpackages.bib', prefix='Rpackage:')
# uncomment inclusion line
x <- gsub("%\\bibliography{Rpackages}", "\\bibliography{Rpackages}", x, fixed = TRUE)
}
x
})
if( !is.null(file) ) cat(cmd, file=file)
else cmd
}
#' Generate RMarkdown Vignette Axiliary Files
#'
#' @details
#' To use this feature add the following in your YAML header:
#' ```
#' header-includes:
#' - \input{"`r pkgmaker::make_vignette_auxfiles('pkgmaker')`"}
#' bibliography: library.bib
#' ```
#'
#' @param input vignette source file.
#' If `NULL` then the current file is obtained via a call to [knitr::current_input].
#' @inheritParams latex_preamble
#' @param bibfile output file for R package citations.
#' @param Rpkg.prefix prefix to use when generating the bibtex entries of cited R packages.
#' If `Rpkg.prefix = 'Rpackage_'`, then Rmardown citations should be `@@Rpackage_mypkg`.
#' @param ... other arguments passed to [latex_preamble]
#'
#' @return Path to the preamble file.
#' @export
#'
make_vignette_auxfiles <- function(PACKAGE, input = NULL, bibfile = 'library.bib', Rpkg.prefix = 'Rpackage_', ...){
if( !requireNamespace('knitr') )
stop("Missing dependency: package 'knitr' is required to create vignette auxiliary files")
input <- input %||% knitr::current_input()
# copy package reference bibfile
ref <- packageReferenceFile(PACKAGE)
if( file.exists(ref) ) file.copy(ref, bibfile, overwrite = TRUE)
# append bib entries for R packages
pkgs_cite <- parsePackageCitation(readLines(input));
write.pkgbib(gsub('^Rpackage_', '', pkgs_cite), file = bibfile, prefix = Rpkg.prefix, append = TRUE)
# generate header file
header_file <- tempfile(paste0(basename(knitr::current_input()), '_header'), fileext = '.tex')
latex_preamble(..., file = header_file, biblatex = FALSE)
# return header file
header_file
}
is.rnw <- function(x){
is(x, 'rnw')
}
#' Compile a Vignette Object
#'
#' @param x an object that represents a vignette
#' @param ... other arguments passed down to the relevant method.
#'
#' @return Returns the value returned by the vignette compiler.
#' @export
runVignette <- function(x, ...){
# flag the vignette as being locally made
opts <- options(R_RUNNING_MANUAL_VIGNETTE=TRUE)
on.exit( options(opts) )
# run
UseMethod('runVignette')
}
#' @export
runVignette.default <- function(x, file=NULL, ...){
stop("Vignette compiler '", class(x), "' is not supported")
}
## #' @param fig.path specification for the figure path (used in knitr vignettes only).
## #' If \code{TRUE} then the figure path is set to \code{'./figure/<basename>/'}.
## #' @param cache.path specification for the cache path.
## #' If \code{TRUE} then the figure path is set to \code{'./cache/<basename>/'}.
#' @export
runVignette.rnw_knitr <- function(x, file=NULL, ..., fig.path=TRUE, cache.path=TRUE){
if( !requireNamespace('knitr', quietly = TRUE) )
stop("Package 'knitr' is required to run knitr vignettes.")
# expand path to cache to fix issue in knitr
bname <- sub("\\..{3}$", '', basename(x$file))
# add suffix for windows
if( .Platform$OS.type == 'windows' ){
bname <- paste(bname, '-win', sep='')
}
# cache.path
if( !isFALSE(cache.path) ){
if( isTRUE(cache.path) ){
cache.path <- file.path(getwd(), 'cache', bname, '/')
}
knitr::opts_chunk$set(cache.path=cache.path)
}
# fig.path
if( !isFALSE(fig.path) ){
if( isTRUE(fig.path) ){
fig.path <- file.path(getwd(), 'figure', str_c(bname,'-'))
}
knitr::opts_chunk$set(fig.path=fig.path)
}
# set other options
knitr::opts_chunk$set(...)
# run knitr
e <- new.env(parent = .GlobalEnv)
if( FALSE && (is.null(file) || file_extension(file) %in% c('tex', 'pdf')) ){
ofile <- if( file_extension(file) == 'pdf' ) file else NULL
knitr::knit2pdf(x$file, ofile, envir=e)
if( is.null(file) ){
# remove pdf file
unlink(file.path(getwd(), basename(file_extension(x$file, 'pdf'))))
} else if( file_extension(file) == 'tex' ){
# move tex file
file.rename(file_extension(file, 'tex'), file)
}
}else knitr::knit(x$file, file, envir=e)
}
#' @export
runVignette.rnw_sweave <- function(x, file=NULL, ...){
res <- Sweave(x$file, driver=x$driver, ...)
# move output file
if( !is.null(file) ){
file.rename(res, file)
}
res
}
#' Utilities for Vignettes
#'
#' \code{rnw} provides a unified interface to run vignettes that detects
#' the type of vignette (Sweave or knitr), and which Sweave driver
#' to use (either automatically or from an embedded command \code{\\VignetteDriver}
#' command).
#'
#' @param x vignette source file specification as a path or a \code{rnw} object.
#' @param file output file
#' @param ... extra arguments passed to \code{as.rnw} that can be used to force
#' certain building parameters.
#' @param raw a logical that indicates if the raw result for the compilation
#' should be returned, instead of the result file path.
#'
#' @return `rnw` returns the result of compiling the vignette with [runVignette].
#' @rdname vignette
#' @export
rnw <- function(x, file=NULL, ..., raw=FALSE){
# library(methods)
# load rnw file
x <- as.rnw(x, ...)
# setup restoration of options and graphical parameters
opts <- options()
gpar <- par(no.readonly=TRUE)
on.exit( {options(opts); par(gpar)})
# copy package cleveref from pkgmaker installation
if( 'cleveref' %in% x$latexPackages ){
clv <- packagePath('cleveref.sty', package='pkgmaker')
message("# Copying package 'cleveref.sty' from ", dirname(clv)," ... ", appendLF=FALSE)
wd <- if( !is.null(file) ) dirname(file) else getwd()
file.copy(clv, wd)
if( file.exists(file.path(wd, basename(clv))) ) message('OK') else message('ERROR')
}
# run vignette
res <- runVignette(x, file=file, ...)
# Package citations
if( !is.null(keys <- x$cite) ){
message("# Writing package bibtex file [", length(keys)," key(s)] ... ", appendLF=FALSE)
write.pkgbib(keys, file='Rpackages.bib', prefix='Rpackage:', verbose=FALSE)
message('OK')
}
#
# return raw result if required
if( raw ) return(res)
# check for a wrapper main file
if( !is.null(x$wrapper) ){
res <- x$wrapper
}
invisible(res)
}
# tells if a vignette is locally made
#' @describeIn vignette tells if a vignette is being run through the function \code{runVignette}
#' of \pkg{pkgmker}, allowing disabling behaviours not allowed in package vignettes that are
#' checked vi \code{R CMD check}.
#'
#' @export
isManualVignette <- function(){
isTRUE(getOption('R_RUNNING_MANUAL_VIGNETTE'))
}
checkFile <- function(x, msg="file '%s' does not exist."){
if( !is.file(x) ) stop(sprintf(msg, x))
TRUE
}
checkRnwFile <- function(x){
if( is.rnw(x) ) x <- x$file
checkFile(x, msg="Vignette file '%s' does not exist.")
}
#' @describeIn vignette creates a S3 \code{rnw} object that contains information
#' about a vignette, e.g., source filename, driver, fixed included files, etc..
#'
#' @param load logical to indicate if all the object's properties should loaded,
#' which is done by parsing the file and look up for specific tags.
#'
#' @export
as.rnw <- function(x, ..., load = TRUE){
if( is.rnw(x) ) return(x)
checkRnwFile(x)
# initialise 'rnw' object
obj <- list()
class(obj) <- 'rnw'
# store source full path
obj$file <- normalizePath(x)
obj$line <- NA
if( !load ) return(obj)
# detect compiler
obj$compiler <- rnwCompiler(obj) %||% 'Sweave'
cl <- if( obj$compiler == 'knitr' ) 'knitr' else 'sweave'
class(obj) <- c(paste('rnw_', cl, sep=''), class(obj))
# detect driver
obj$driver <- rnwDriver(obj) %||% RweaveLatex()
# detect wrapper
obj$wrapper <- rnwWrapper(obj)
# detect fixed included images
obj$includes <- rnwIncludes(obj)
# detect latex packages
obj$latexPackages <- rnwLatexPackages(obj)
# detect children vignettes
obj$children <- rnwChildren(obj)
# detect package citations
obj$cite <- rnwCite(obj)
# override with passed extra arguments
if( nargs() > 1L ){
dots <- list(...)
obj[names(dots)] <- dots
}
# return object
obj
}
rnwObject <- function(...) as.rnw(..., load=FALSE)
rnwParser <- function(tag, name=tolower(tag), trim=TRUE, commented=FALSE, options=FALSE, first=FALSE){
function(x, verbose=TRUE){
x <- rnwObject(x)
# read all lines in
l <- readLines(x$file)
# identify driver
dr <- str_match(l, str_c("^\\s*"
, if( commented ) '%'
,"\\s*\\\\", tag
, if( options ) "(\\[[^]]*\\])?"
, "\\{([^}]*)\\}"))
w <- which(!is.na(dr[,1L]))
if( length(w) > 0L ){
if( first ) w <- w[1L]
s <- dr[w, if( options ) 3L else 2L]
# trim if necessary
if( trim ) s <- str_trim(s)
if( verbose ) rnw_message("Detected ", name, ": "
,paste("'", s, "'", sep='', collapse=', '))
s
}
}
}
rnwVignetteParser <- function(tag, ...){
rnwParser(str_c('Vignette',tag), name=tolower(tag), ..., commented=TRUE, first=TRUE)
}
rnwLatexPackages <- rnwParser('usepackage', name='LaTeX package(s)', options=TRUE)
#' @describeIn vignette tries to detect the vignette compiler to use on a vignette
#' source file, e.g., \code{\link{Sweave}} or [knitr][knitr::knitr-package].
#'
#' @param verbose logical that toggles verbosity
#'
#' @export
rnwCompiler <- rnwVignetteParser('Compiler')
#' @describeIn vignette tries to detect the type of vignette and if it is meant
#' to be wrapped into another main file.
#'
#' @export
rnwWrapper <- rnwVignetteParser('Wrapper')
#' @describeIn vignette tries to detect Sweave driver to use on a vignette source
#' file, e.g., \code{SweaveCache}, \code{highlight}, etc..
#'
#' @export
rnwDriver <- function(x){
parse_driver <- rnwVignetteParser('Driver', trim=FALSE)
if( !is.null(s <- parse_driver(x)) ){
# eval text
eval(parse(text=s))
}
}
#' @describeIn vignette detects fixed includes, e.g., image or pdf files, that are
#' required to build the final document.
#'
#' @export
rnwIncludes <- function(x){
x <- rnwObject(x)
# read all lines in
l <- readLines(x$file)
# identify driver
dr <- suppressWarnings(str_match(l, "^\\s*\\\\((include)|(includegraphics)|(input))\\{([^}]*)\\}"))
w <- which(!is.na(dr[,1L]))
rnw_message("Detected includes: ", appendLF=FALSE)
if( length(w) > 0L ){
inc <- str_trim(dr[w,6L])
message(str_out(inc))
inc
}else
message("NONE")
}
#' @describeIn vignette detects included vignette documents and return them as a
#' list of vignette objects.
#'
#' @export
rnwChildren <- function(x){
x <- rnwObject(x)
# read all lines in
l <- readLines(x$file)
# identify driver
dr <- str_match(l, "^\\s*\\\\SweaveInput\\{([^}]*)\\}")
w <- which(!is.na(dr[,1L]))
if( length(w) > 0L ){
inc <- dr[w,2L]
rnw_message("Detected children: ", str_out(inc, Inf))
owd <- setwd(dirname(x$file))
on.exit( setwd(owd) )
mapply(as.rnw, inc, line=w, SIMPLIFY=FALSE)
}
}
#' Formatting Package Citations in Sweave/knitr Documents
#'
#' @param x output document, as a single string.
#'
#' @return A character vecotr of citation references.
#'
#' @export
parsePackageCitation <- function(x){
if( length(x) > 1L ) x <- paste(x, collapse = "\n")
.parse <- function(x, pattern, idx){
dr <- str_match_all(x, pattern)
dr <- dr[sapply(dr, length)>0L]
unlist(lapply(dr, '[', , idx))
}
# extract package citations: \citeCRANpkg - like
x <- gsub(".*[^%]* *\\\\begin\\{document\\}(.*)", "\\1", x)
cite <- .parse(x, "\\\\cite((CRAN)|(BioC)|(BioCAnn))?pkg[*]?\\{([^}]*)\\}", 6L)
# \cite{Rpackage:pkgname, ...} - like
cite2 <- .parse(x, "\\\\(no)?cite[^{ ]*\\{([^}]*)\\}", 3L)
if( length(cite2) ){
cite2 <- .parse(cite2, 'Rpackage:([^,} ]+)', 2L)
cite <- c(cite, cite2)
}
# remove Rpackage prefix
if( length(cite) ){
cite <- str_trim(unlist(strsplit(cite, ",")))
cite <- gsub('^Rpackage:', '', cite)
}
inc <- character()
if( length(cite) > 0L ){
inc <- unique(str_trim(unlist(strsplit(cite, ","))))
}
inc
}
#' \code{bibcite} provides an inline package citation functionnality.
#' Technically it adds a given Bibtex key to a cache that is used at the end of the
#' document processing to generate a .bib file with all citation keys.
#'
#' @param key citation Bibtex key(s) as a character vector
#' @param cache specifies what to do with the previsouly chached keys.
#' If \code{TRUE}, then \code{key} is added to the cache.
#' If \code{NULL}, then all previously cached keys are deleted, before .
#' If a character string, then it specifies the path to a Bibtex file that is loaded
#' to initialise the cache.
#' @param ... extra arguments passed to [rbibutils::readBib].
#' @keywords internal
cite_pkg <- local({
.keys <- character()
function(key, cache = NA, ...){
# return whole cache
if( !nargs() ) return(.keys)
# reset cache
if( is.null(cache) ) .keys <- character()
else if( isString(cache) ){
.keys <- .read.bib(file = cache, ...)
}
if( !missing(key) ){
cat(key)
.keys <<- c(.keys, key)
}
}
})
rnwCite <- function(x){
x <- rnwObject(x)
# read all lines in
l <- readLines(x$file)
.parse <- function(x, pattern, idx){
dr <- str_match_all(x, pattern)
dr <- dr[sapply(dr, length)>0L]
unlist(lapply(dr, '[', , idx))
}
# extract package citations: \citeCRANpkg - like
cite <- .parse(l, "\\\\cite((CRAN)|(BioC)|(BioCAnn))?pkg[*]?\\{([^}]*)\\}", 6L)
# \cite{Rpackage:pkgname, ...} - like
cite2 <- .parse(l, "\\\\cite[^{ ]*\\{([^}]*)\\}", 2L)
if( length(cite2) ){
cite2 <- .parse(cite2, '.*Rpackage:([^,}]+).*', 2L)
cite <- c(cite, cite2)
}
# remove Rpackage prefix
if( length(cite) ){
cite <- unlist(strsplit(cite, ","))
cite <- gsub('^Rpackage:', '', cite)
}
rnw_message("Detected package citation(s): ", appendLF=FALSE)
if( length(cite) > 0L ){
inc <- unique(str_trim(unlist(strsplit(cite, ","))))
message(str_out(inc), ' [', length(inc), ']')
inc
}else
message("NONE")
}
# substitute a makefile template variable
subMakeVar <- function(mvar, value, text){
sub(str_c('#%', mvar, '%#'), value, text, fixed=TRUE)
}
# define a makefile template variable
defMakeVar <- function(var, value, ..., mvar=var){
subMakeVar(mvar, str_c(var, '=', value), ...)
}
quick_install <- function(path, ..., lib.loc){
if( !is.dir(lib.loc) ){
stop("Installation directory '", lib.loc, "' does not exist.")
}
olib <- .libPaths()
.libPaths(lib.loc)
on.exit( .libPaths(olib) )
pkg <- devtools::install(path, ...)
}
vignetteCheckMode <- checkMode_function('_R_CHECK_BUILDING_VIGNETTES_')
#' @describeIn vignette returns the path to a generic makefile used to make
#' vignettes.
#'
#' @param package package name.
#' If \code{NULL}, a DESRIPTION file is looked for one directory up: this
#' meant to work when building a vignette directly from a package's
#' \code{'vignettes'} sub-directory.
#' @param skip Vignette files to skip (basename).
#' @param print logical that specifies if the path should be printed or
#' only returned.
#' @param template template Makefile to use.
#' The default is to use the file \dQuote{vignette.mk} shipped with the package
#' \pkg{pkgmaker} and can be found in its install root directory.
#' @param temp logical that indicates if the generated makefile should using a
#' temporary filename (\code{TRUE}), or simply named \dQuote{vignette.mk}
#' @param checkMode logical that indicates if the vignettes should be generated as in a
#' CRAN check (\code{TRUE}) or in development mode, in which case \code{pdflatex}, \code{bibtex},
#' and, optionally, \code{qpdf} are required.
#' @param user character vector containing usernames that enforce \code{checkMode=TRUE},
#' if the function is called from within their session.
#' @param tests logical that enables the compilation of a vignette that gathers all unit
#' test results.
#' Note that this means that all unit tests are run before generating the vignette.
#' However, unit tests are not (re)-run at this stage when the vignettes are built
#' when checking the package with \code{R CMD check}.
#'
#' @export
vignetteMakefile <- function(package=NULL, skip=NULL, print=TRUE, template=NULL, temp=FALSE
, checkMode = isCHECK() || vignetteCheckMode()
, user = NULL, tests=TRUE){
# library(methods)
## create makefile from template
# load template makefile
if( is.null(template) )
template <- packagePath('vignette.mk', package='pkgmaker')
l <- paste(readLines(template), collapse="\n")
# R_BIN
l <- subMakeVar('R_BIN', R.home('bin'), l)
#
if( checkMode ){
oldCM <- vignetteCheckMode(TRUE)
on.exit( vignetteCheckMode(oldCM) )
}
# Check user: LOCAL_MODE if in declared user
localMode <- !checkMode
cuser <- Sys.info()["user"]
l <- subMakeVar('VIGNETTE_USER', cuser, l)
maintainers <- '-'
if( !is.null(user) ){
maintainers <- str_c(user, collapse=', ')
if( cuser %in% user ){
localMode <- TRUE
}
}
l <- subMakeVar('VIGNETTE_MAINTAINERS', maintainers, l)
# define variable LOCAL_MODE
if( localMode ){
l <- defMakeVar('LOCAL_MODE', cuser, l)
}
# Package name
pkg_dir <- dirname(getwd())
loc_package <- if( is.file(df <- file.path(pkg_dir, 'DESCRIPTION')) ){
d <- try(read.dcf(df), silent=TRUE)
d <- as.list(as.data.frame(d, stringsAsFactors=FALSE))
d$Package
}
if( !is.null(loc_package) && (is.null(package) || identical(loc_package, package)) ) package <- loc_package
else if( !identical(loc_package, package) && length(pkg_dir <- find.package(package, quiet=TRUE)) ){
d <- packageDescription(package)
}else{
stop("Could not load DESCRIPTION file for package '", package, "'.")
}
l <- defMakeVar('MAKE_R_PACKAGE', package, l)
l <- subMakeVar('R_PACKAGE_DESCRIPTION', pkg_dir, l)
# R_LIBS: add package's dev lib if necessary
Rlibs <- NULL
if( localMode && is.dir(devlib <- file.path(getwd(), '..', '..', 'lib')) ){
Rlibs <- devlib
}
Rlibs <- paste(c(Rlibs, "$(TMP_INSTALL_DIR)", "$(R_LIBS)"), collapse=.Platform$path.sep)
l <- subMakeVar('R_LIBS_DEV', Rlibs, l)
# TMP_INSTALL_DIR: temporary install directory
l <- subMakeVar('TMP_INSTALL_DIR', file.path(dirname(tempdir()), basename(tempfile('Rpkglib_'))), l)
# Vignettes files:
# - look into src/ for real vignettes
# - check presence of a test directory ../tests/
# - check current directory for non fake vignettes
rnwFiles <- NULL
# src
if( is.dir('src') ) rnwFiles <- list.files('src', pattern="\\.Rnw$")
# unit tests
if( tests && is.dir('../tests') && !is.dir('../tests/testthat') ) rnwFiles <- c(rnwFiles, str_c(package, '-unitTests.Rnw'))
# non-fake vignettes
rnwFiles <- c(rnwFiles, list.files('.', pattern="\\.Rnw$"))
# substitute in makefile
rnwFiles <- unique(rnwFiles)
if( !is.null(skip) )
rnwFiles <- setdiff(rnwFiles, skip)
l <- subMakeVar('RNW_SRCS', paste(rnwFiles, collapse=' '), l)
# reset pdf objects in local mode to point to ../inst/doc
noBuildVignettes <- if( !is.null(d$BuildVignettes) ) tolower(d$BuildVignettes)=='no' else FALSE
if( localMode && noBuildVignettes ){
l <- defMakeVar('INST_TARGET', 1, l)
l <- defMakeVar('PDF_OBJS'
, paste(file.path('../inst/doc', sub("\\.Rnw$", ".pdf", rnwFiles)), collapse=' ')
, l)
}
l <- defMakeVar('PDF_OBJS'
, paste(file.path('../inst/doc', sub("\\.Rnw$", ".pdf", rnwFiles)), collapse=' ')
, l)
# create makefile
mk <- if( temp ) tempfile('vignette_', tmpdir='.', fileext='.mk') else 'vignette.mk'
cat(l, file=mk)
if ( print ){
cat(mk)
}
invisible(l)
}
#' @describeIn vignette compacts vignette PDFs using either \code{gs_quality='none'} or \code{'ebook'},
#' depending on which compacts best (as per CRAN check criteria).
#'
#' @inheritParams tools::compactPDF
#'
#' @export
compactVignettes <- function(paths, ...){
td <- tempfile(basename(paths))
file.copy(paths, td)
res <- tools::compactPDF(td, gs_quality = "none", ...) # use qpdf
diff_none <- format(res, diff = 1e5)
res <- tools::compactPDF(td, gs_quality = "ebook", ...)
diff_ebook <- format(res, diff = 2.5e5) # 250 KB for now
if( length(diff_ebook) ){
tools::compactPDF(paths, gs_quality = "ebook", ...)
invisible('ebook')
}else{
tools::compactPDF(paths, gs_quality = "none", ...)
invisible('none')
}
}
buildPackageVignette <- function(file, ..., install = NULL){
# detect package directory
file_path <- normalizePath(file)
pkg <- as.package(dirname(file_path))
# install if necessary
if( !isFALSE(install) ){
pkglib <- install %||% file.path(tempdir(), 'buildVignette_lib')
dir.create(pkglib, recursive = TRUE, showWarnings = FALSE)
# compute MD5sum
md5 <- tools::md5sum(list.files(file.path(pkg$path, c('R')), full.names = TRUE))
hash <- digest(md5)
pkglib_path <- file.path(pkglib, pkg$package)
hash0 <- if( file.exists(hash_file <- paste0(pkglib_path, '.md5')) ) readLines(hash_file)
# cleanup if forcing installation
if( isTRUE(install) ){
unlink(hash_file)
unlink(pkglib_path, recursive = TRUE)
}
# install if necessary
if( !is.dir(pkglib_path) || !identical(hash0, hash) ){
quickinstall(pkg$path, pkglib)
}
cat(hash, "\n", sep = "", file = hash_file)
# prepend library
ol <- set_lib(pkglib)
on.exit( .libPaths(ol), add = TRUE )
# ov <- set_envvar(list(R_LIBS_USER = paste0(pkglib, ':', Sys.getenv('R_LIBS_USER'))), 'replace')
# on.exit( set_envvar(ov, 'replace'), add = TRUE )
}
# build vignette
tools::buildVignette(file, ...)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.