Nothing
R/package.skeleton.dx.R
In inlinedocs: Convert inline comments to documentation
#
# vim:set ff=unix expandtab ts=2 sw=2:
#################################################################
writePackageRdFile <- function(pkgDir,name,path){
p=file.path(".")
promptPackage(
name,
filename = file.path(path, sprintf("%s-package.Rd", name)),
lib.loc = p
)
}
#################################################################
writeFunctionRdFiles <- function(e,pkgDir,path,inlinedocs.documentNamespaceOnly){
### At the moment only empty files are written (and later filled my modify.Rd.file) although the complete information is
### already present at this stage. Future versions will finish the job right here, rendering modify.Rd file unnecassary
### but only after all the other stuff can be written directly too.
objs <- sapply(ls(e),get,e,simplify=FALSE)
funs<- objs[unlist(sapply(objs,is.function))]
# note that ls will not find S4 methods for generic functions which are treated elsewhere
if (inlinedocs.documentNamespaceOnly){
fnames<- union(
exportedFunctions(pkgDir),
exportedGenerics(pkgDir)
)
functionList <- fnames
}else{
functionList<- names(funs)
}
list0 <- fixPackageFileNames(functionList)
names(list0) <- functionList
sapply(
functionList,
function(item) {
fn <- file.path(path, paste(list0[[item]],".Rd",sep=""))
prompt(
#get(item, envir = e),
funs[[item]],
name = item,
filename = fn
)
}
)
}
#################################################################
writeClassRdFiles <- function(environment,pkgDir,path,inlinedocs.documentNamespaceOnly){
if (inlinedocs.documentNamespaceOnly){
classesList<- exportedClasses(pkgDir)
}else{
classesList<- allClasses(environment)
}
classes0 <- fixPackageFileNames(classesList)
names(classes0) <- classesList
sapply(classesList, function(item) {
methods::promptClass(item, filename = file.path(path,
sprintf("%s-class.Rd", classes0[item])), where = environment)
})
}
#################################################################
writeMethodRdFiles <- function(e,pkgDir,path,inlinedocs.documentNamespaceOnly=FALSE){
## add files that document a single method
if(inlinedocs.documentNamespaceOnly){
#gens <- exportedDocumentableMeths(e,pkgdir)
gens <- exportedDocumentableMeths(e,pkgDir)
}else{
gens <- documentableMeths(e)
}
##pp("gens",environment())
#####################################
genericFuncNames=names(gens)
for(genName in genericFuncNames){
methDefs=gens[[genName]]
for ( method in methDefs){
#method <- getMethod(genName,sig,where=e)
#src=getSource(method)
sig=methSig(method)
src=as.character(getSrcref(unRematchDefinition(method)))
N <- methodDocName(genName,sig)
# renaming of operator files like package.skeleton does
Nme <- fixPackageFileNames(N)
# check if the filename is compatible
# this can be a problem for [[ $
#pp("N",environment())
##pp("src", environment())
f=paste(Nme,".Rd",sep="")
fff <- eval(parse(text=str_split(src,"\n")))
#pe(quote(getwd()),environment())
# write docu to a list
l=prompt(fff,filename=NA)
#pp("l",environment())
l[["name"]]=paste("\\name{",N,"}",sep="")
l[["aliases"]]=paste("\\alias{",N,"}",sep="")
# in every section of the list replace fff by the name of the Generic
for (i in seq_along(l)){
l[[i]] <- gsub("fff",genName,l[[i]])
}
## Note:
## The usage section from the R generated method description causes a warning
## about a missing alias.
## For example:
## If we have a generic function exampleGen with a mehthod for Class "A"
## the "prompt" call and subsequent renameing above would set:
## l[["alias"]] <- "exampleGen-method-#A" while the usage section
## l[["usage"]] <- "exampleGen(object)"
## If this was written to the Rd file later R CMD check will WARN that it
## did not find the name used in the usage section of the file as an alias in the same file.
## "R CMD check" usually expects a usage section of the kind
## l[["usage"]] == "exampleGen-method-#A(object)" or
## l[["usage"]] == "Alias1" or
## l[["usage"]] == "Alias2" ...
## But for a mehthod of a Generic the usage section should contain the name of that Generic.
## The temptation is to set the alias to the name of the Generic,
## but this would be a disaster:
## A user typing ?exampleGen would not get either:
## - the documentation of the generic function "exampleGen" or
## - the documentation of one of the first method implementig "exampleGen"
## - the documentation of one of the second method implementig "exampleGen"
## - ...
## The last file sourced by R's help system containing an \alias{"exampleGen""}
## would be shown.
## So we could either ignore the (unfounded) WARNING or remove the usage section completely
## from the method decription (which I will do here as default)
l <- l[setdiff(names(l),"usage")]
# we can also remove the alias since we do not need it.
#l <- l[setdiff(names(l),"aliases")]
p=file.path(path,f)
cat(unlist(l), file = p, sep = "\n")
}
}
}
#################################################################
writeMethodTableRdFiles <- function(e,pkgDir,path,inlinedocs.documentNamespaceOnly=FALSE){
gens <- documentableMeths(e)
if(inlinedocs.documentNamespaceOnly){
exported=exportedDocumentableMeths(e,pkgDir)
}else{
exported=gens
}
## we only look at generic which have methods we can document
#gens <- methodTable(exprs,e)
genericFuncNames=names(gens)
for (genName in genericFuncNames){
if(is.element(genName,names(exported))){
exportedMeths <- exported[[genName]]
}else{
exportedMeths=NULL
}
l <- mmPromptMethods(
genName=genName,filename=NA,
exportedMeths=exportedMeths,
where=e
)
f=fixPackageFileNames(paste(genName,"-methods.Rd",sep=""))
#pe(quote(getwd()),environment())
p=file.path(path,f)
#pp("p",environment())
cat(unlist(l), file = p, sep = "\n")
}
}
#################################################################
package.skeleton.dx <- structure(function # Package skeleton deluxe
### Generates Rd files for a package based on R code and DESCRIPTION
### metadata. After inspecting the specified R code files to find
### inline documentation, it calls the standard package.skeleton
### function, which creates bare Rd files. The inline documentation is
### added to these Rd files and then these files are copied to
### pkgdir/man, possibly overwriting the previous files there.
(pkgdir="..",
### Package directory where the DESCRIPTION file lives. Your code
### should be in pkgdir/R. We will setwd to pkgdir/R for the duration
### of the function, then switch back to where you were previously.
parsers=NULL,
### List of Parser functions, which will be applied in sequence to
### extract documentation from your code. Default NULL means to first
### search for a definition in the variable "parsers" in
### pkgdir/R/.inlinedocs.R, if that file exists. If not, we use the
### list defined in options("inlinedocs.parsers"), if that is
### defined. If not, we use the package global default in the variable
### default.parsers.
namespace = FALSE,
### A logical indicating whether a NAMESPACE file should be generated
### for this package. If \code{TRUE}, all objects whose name starts
### with a letter, plus all S4 methods and classes are exported.
excludePattern=FALSE,
### A regular expression matching the files that are not to be
### processed e.g. because inlinedocs can not handle them yet (like
### generic function definitions)
inlinedocs.documentNamespaceOnly=FALSE,
### A boolean flag indicating if documentation is only built for exported
inlinedocs.exampleDir=file.path(pkgdir,"..","inst","tests"),
### A string pointing to the location where inlinedocs should search for external examples
inlinedocs.exampleTrunk="example.",
### A string used to identify the files containing external examples in the example directory. All file names of external examples have to start with this string
...
### Parameters to pass to Parser Functions.
){
## This causes a warning on R CMD check TDH 28 Jan 2013.
##alias< < inlinedocs
oldLocation=getwd()
chdir <- file.path(pkgdir,"R")
## adapt the possibly relative path to the examples to the new location
if (!grepl("^\\/",inlinedocs.exampleDir)){
inlinedocs.exampleDir=file.path(oldLocation,inlinedocs.exampleDir)
}
if(!file.exists(chdir))stop("need pkgdir/R, tried ",chdir)
old.wd <- setwd(chdir)
on.exit(setwd(old.wd))
# PhG: R allows for specific code to be in /unix, or /windows subdirectories
# but apparently, inlinedocs does not support this. I think it is fair to
# stop here with an explicit error message if at least one of /unix or
# /windows subdirectory is found!
# file_test(-d, ...) does the job, but I don't want to add a dependency on
# package 'utils", where it lives. So, I prefer using file.info()
if (isTRUE(file.info("unix")$isdir) || isTRUE(file.info("windows")$isdir))
stop("Platform-specific code in ./R/unix, or ./R/windows is not supported")
## Default values and required fields in DESCRIPTION file.
description.defaults <-
c("Package"="",
"Maintainer"=Sys.getenv("USER"),
"Author"=Sys.getenv("USER"),
"Version"="1.0",
"License"="GPL-3",
"Title"="a package",
"Description"="a package that does\n many things.")
## Necessary fields in DESCRIPTION, otherwise error.
fields <- names(description.defaults)
## Default DESCRIPTION, written if it doesn't exist.
empty.description <-
matrix(description.defaults,ncol=length(fields),dimnames=list(NULL,fields))
## if no DESCRIPTION, make one and exit.
descfile <- file.path("..","DESCRIPTION")
if(!file.exists(descfile)){
write.dcf(empty.description,descfile)
stop("Need ",descfile,"; please fill that in and try again")
}
## Read description and check for errors
desc <- read.dcf(descfile)
## TDH 3 Sept 2013 need to support Authors@R for CRAN.
if("Authors@R" %in% colnames(desc)){
author <- paste(eval(parse(text=desc[,"Authors@R"])), collapse=", ")
desc <- cbind(desc,
Author=author,
Maintainer=author)
}
if(any(f <- !sapply(fields,is.element,colnames(desc))))
stop("Need ", paste(names(f)[f], collapse = ", "), " in ", descfile)
#PhG: corrected from stop("Need ",names(f)[f]," in ",descfile)
if(any(f <- sapply(fields,function(f)desc[,f]=="")))
stop("Need a value for ", paste(names(f)[f], collapse = ", "),
" in ", descfile)
#PhG: corrected from stop("Need a value for ",names(f)[f]," in ",descfile)
## Load necessary packages before loading pkg code
if("Depends" %in% colnames(desc)){
required <- strsplit(desc[,"Depends"],split=",")[[1]]
# PhG: for packages with NAMESPACE, dependencies are also listes in the
# Imports field!
} else required <- character(0)
# PhG: packages listed in Imports field are not supposed to be attached to the
# search path when a package with NAMESPACE is loaded, only the namespace is
# loaded. However, the code here is not loaded as it should be, and we need to
# load also these Import(ed) packages to get correct results in the present
# case (to be checked with most complex cases!)
if ("Imports" %in% colnames(desc))
required <- c(required, strsplit(desc[, "Imports"], split = ",")[[1]])
##print(c("required=",required))
## This may need some refining, basically I just tried to take the
## first word from each vector element, stripping of whitespace in
## front and anything after:
#pkgnames <- gsub("\\W*(\\w+)\\b.*","\\1",required)
# PhG: the previous line is wrong: it does not work with package names
# like R.oo... Extract from Writing R Extensions manual:
# "The `Package' and `Version' fields give the name and the version of the
# package, respectively. The name should consist of letters, numbers, and the
# dot character and start with a letter."
# Consequently, I propose:
pkgnames <- gsub("\\W*([a-zA-Z][a-zA-Z0-9.]*)\\b.*", "\\1", required)
# PhG: We need to eliminate 'R' from the list!
pkgnames <- pkgnames[pkgnames != "R"]
# PhG: if we create a namespace, we need to keep this list for further use
if (isTRUE(namespace)) allpkgs <- pkgnames
# PhG: We eliminate also from the list the packages that are already loaded
if(length(pkgnames))
pkgnames <- pkgnames[!sprintf("package:%s",pkgnames) %in% search()]
# PhG: according to Writing R Extensions manual, a package name can occur
# several times in Depends
pkgnames <- unique(pkgnames)
if (length(pkgnames)) {
# PhG: A civilized function returns the system in the same state it was
# before => detach loaded packages at the end!
on.exit(suppressWarnings({
try(for (pkg in pkgnames)detach(paste("package", pkg, sep = ":"),
unload = TRUE, character.only = TRUE), silent = TRUE)
}), add = TRUE)
# PhG: Shouldn't we need to check that packages are loaded and shouldn't
# we exit with an explicit error message if not? Note: we don't use version
# information here. That means we may well load wrong version of the
# packages... and that is NOT detected as an error!
pkgmissing <- character(0)
for (pkg in pkgnames) {
if(!require(pkg, character.only = TRUE)){
pkgmissing <- c(pkgmissing, pkg)
}
}
if (length(pkgmissing))
stop("Need missing package(s): ", paste(pkgmissing, collapse = ", "))
}
## for the parser list, first try reading package-specific
## configuration file
if(is.null(parsers))parsers <- tryCatch({
cfg <- new.env()
sys.source(cfile <- ".inlinedocs.R",cfg)
L <- cfg$parsers
if(!is.null(L))cat("Using parsers in ",cfile,"\n",sep="")
L
},error=function(e)NULL)
## then try the global options()
opt <- "inlinedocs.parsers"
if(is.null(parsers)&&!is.null(parsers <- getOption(opt))){
cat("Using parsers in option ",opt,"\n",sep="")
}
## if nothing configured, just use the pkg default
if(is.null(parsers))parsers <- default.parsers
## concatenate code files and parse them
# PhG: in Writing R Extensions manuals, source code in /R subdirectory can
# have .R, .S, .q, .r, or .s extension. However, it makes sense to restrict
# this to .R only for inlinedocs, but a clear indication is required in the
# man page!
code_files <- if(!"Collate"%in%colnames(desc)) Sys.glob("*.R") else
strsplit(gsub("\\s+"," ",desc[,"Collate"]),split=" ")[[1]]
## TW 29 April 2015 remove single quotes surrounding the filename
# that are inserted by roxygen2 into collate field
# and that do not work with source
code_files <- sub("^'", "", sub("'$", "", code_files))
code_files =grep(excludePattern,code_files,invert=TRUE,value=TRUE)
## TDH 28 Jan 2013, warn users such as Pierre Neuvial if they have
## comments on the last line of one input file. Sometimes comments
# on the last line can appear to be the first line of comments of
## the next code file.
lines.list <- lapply(code_files,readLines)
for(i in seq_along(lines.list)){
lvec <- lines.list[[i]]
fn <- code_files[i]
last <- lvec[length(lvec)]
if(grepl("#",last)){
warning("comment on last line of ",fn,
", unexpected docs may be extracted")
}
}
#print(excludePattern)
## Make package skeleton and edit Rd files (eventually just don't
## use package.skeleton at all?)
name <- desc[,"Package"]
unlink(name,recursive=TRUE)
# # PhG: one must consider a potential Encoding field in DESCRIPTION file!
# which is used also for .R files according to Writing R Extensions
if ("Encoding" %in% colnames(desc)) {
oEnc <- options(encoding = desc[1, "Encoding"])$encoding
on.exit(options(encoding = oEnc), add = TRUE)
}
code <- do.call(c,lapply(code_files,readLines))
# #print(code)
L<- apply.parsers(code,parsers,verbose=TRUE,desc=desc,inlinedocs.exampleDir,inlinedocs.exampleTrunk)
docs <- L[["docs"]]
e <- L[["env"]]
objs <- L[["objs"]]
exprs<- L[["exprs"]]
#mm.package.skeleton(name=name,code_files=code_files,environment=e)
p=file.path(name,"man")
dir.create(p,recursive=TRUE)
f="DESCRIPTION";file.copy(file.path("..",f),file.path(name,f))
#f="NAMESPACE";file.copy(file.path("..",f),file.path(name,f))
writeFunctionRdFiles(e,pkgDir="..",path=p,inlinedocs.documentNamespaceOnly)
writeMethodTableRdFiles(e,pkgDir="..",path=p,inlinedocs.documentNamespaceOnly)
writeMethodRdFiles(e,"..",path=p,inlinedocs.documentNamespaceOnly)
writeClassRdFiles(e,pkgDir="..",path=p,inlinedocs.documentNamespaceOnly)
writePackageRdFile(pkgDir="..",name=name,path=p)
cat("Modifying files automatically generated by package.skeleton:\n")
## documentation of generics may be duplicated among source files.
dup.names <- duplicated(names(docs))
if ( any(dup.names) ){
warning("duplicated file names in docs: ",paste(names(docs)[dup.names]))
}
for(N in unique(names(docs))) {
modify.Rd.file(N,name,docs)
if(grepl("class",N)){
removeAliasesfrom.Rd.file(N,name,code,e)
}
}
file.copy(file.path(name,'man'),"..",recursive=TRUE)
# PhG: copy NAMESPACE file back
if (isTRUE(namespace)) {
# PhG: package.skeleton() does not add import() statement, but here the
# philosophy is to get a fully compilable package, which is not the
# case at this stage with a NAMESPACE. So, we add all packages listed
# in Depends and Imports fields of the DESCRIPTION file in an import()
# statement in the NAMESPACE
nmspFile <- file.path("..", "NAMESPACE")
cat("import(", paste(allpkgs, collapse = ", "), ")\n\n", sep = "",
file = nmspFile)
# PhG: append the content of the NAMESPACE file generated by
# package.skeleton()
file.append(nmspFile, file.path(name,'NAMESPACE'))
# PhG: we also have to export S3 methods explictly in the NAMESPACE
cat("\n", file = nmspFile, append = TRUE)
for (N in unique(names(docs))) {
d <- docs[[N]]
if (!is.null(d$.s3method))
cat('S3method("', d$.s3method[1], '", "', d$.s3method[2], '")\n',
sep = "", file = nmspFile, append = TRUE)
}
}
unlink(name,recursive=TRUE)
},ex=function(){
owd <- setwd(tempdir())
## get the path to the silly example package that is provided with
## package inlinedocs
testPackagePath <- file.path(system.file(package="inlinedocs"),"silly")
## copy example project to the current unlocked workspace that can
## be modified
file.copy(testPackagePath,".",recursive=TRUE)
## generate documentation .Rd files for this package
package.skeleton.dx("silly")
## check the package to see if generated documentation passes
## without WARNINGs.
if(interactive()){
cmd <- sprintf("%s CMD check --as-cran silly",file.path(R.home("bin"), "R"))
print(cmd)
checkLines <- system(cmd,intern=TRUE)
warnLines <- grep("WARNING",checkLines,value=TRUE)
if(length(warnLines)>0){
writeLines(checkLines)
cat("\n\nLines with WARNING:\n")
print(warnLines)
## disable due to bug in R CMD check:
## https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=14875
##stop("WARNING encountered in package check!")
}
}
## cleanup: remove the test package from current workspace again
unlink("silly",recursive=TRUE)
setwd(owd)
})
replace.one <- function
### Do find and replace for one element of an inner documentation list
### on 1 Rd file.
(torep,
### tag to find.
REP,
### contents of tag to put inside.
txt
### text in which to search.
){
##if(grepl("Using the same conventions",REP))browser()
# sometimes torep might be the empty string "" which would lead to emptying the
# whole textbody due to the substitution rule.
# To avoid this we check:
if (torep==""){return(txt)}
escape.backslashes <- function(x)gsub("\\\\","\\\\\\\\",x)
cat(" ",torep,sep="")
FIND1 <- escape.backslashes(torep)
##pp("FIND1",environment())
FIND <- gsub("([{}])","\\\\\\1",FIND1)
FIND <- paste(FIND,"[{][^}]*[}]",sep="")
REP.esc <- escape.backslashes(REP)
## need to escape backslashes for faithful copying of the comments
## to the Rd file:
REP <- paste(FIND1,"{",REP.esc,"}",sep="")
## escape percent signs in R code:
REP <- gsub("%","\\\\\\\\%",REP)
## alias (in particular) need to change only the first one generated
## (generic methods in classes add to standard skeleton alias set)
if ( torep %in% c("alias") ){
txt <- sub(FIND,REP,txt)
} else {
txt <- gsub(FIND,REP,txt)
}
classrep <- sub("item{(.*)}","item{\\\\code{\\1}:}",torep,perl=TRUE)
if ( classrep != torep ){
## in xxx-class files, slots are documented with:
## \item{\code{name}:}{Object of class \code{"function"} ~~ }
## which requires slightly different processing
FIND1 <- escape.backslashes(classrep)
FIND <-
paste(gsub("([{}])","\\\\\\1",FIND1),
"\\{Object of class \\\\code\\{\\\"(\\S+)\\\"\\}[^}]*[}]",sep="")
## need to escape backslashes for faithful copying of the comments
## to the Rd file and also put the class type in parentheses.
REP <- paste(FIND1,"{(\\\\code{\\1}) ",REP.esc,"}",sep="")
## escape percent signs in R code:
REP <- gsub("%","\\\\\\\\%",REP)
txt <- gsub(FIND,REP,txt)
}
txt
}
removeAliasesfrom.Rd.file <- function
### remove aliases to methodnames from the Rd file of a class
### automatically-generated by package.skeleton.
(N,
### Name of function/file to which we will add documentation.
pkg,
### Package name.
code,
### The code of the package
e
### The environment
)
{
# <mm:package.skeleton adds some duplicated aliases to the .*-class.Rd files
# to get rid of the warnings from R CMD check
# we have to delete them
# the duplicated aliases have 2 sources
Nme <- fixPackageFileNames(N)
fb <- paste(Nme,".Rd",sep="")
f <- file.path(pkg,'man',fb)
## If we do.not.generate this file, it does not exist so we need to
## do nothing to avoid errors.
if(!file.exists(f))return()
dlines <- readLines(f)
name=gsub("-class","",N)
# these we will later comment out
# now we look at all the aliases produces by package.skeleton
aliasLine2name=function(line){return(gsub("^\\\\alias\\{(.*)\\}","\\1",line))}
aliasInd <- grep("^\\\\alias.*",dlines)
# aliasnames=as.character(lapply(dlines[aliasInd],aliasLine2name))
# duplicates= intersect(methodnames,aliasnames)
if(length(aliasInd)){
# first get rid of the ${classname}-mehthod stuff
p1=paste(",",name,"-method",sep="")
# next get rid of the -mehthod stuff
patterns=c(p1,",ANY-method",",ANY",",character")
for (pattern in patterns){
dlines[aliasInd] <- gsub(pattern,"",dlines[aliasInd])
}
}
# next:
# the names of the methods implemented by the class
# which occur in all ".*-class.Rd" files
# as aliases
# to find them we ask for those methods but
# therefore have to read the the code to be documented.
# As the apply.parsers function we do this in a separate
# environment
# mm:
# This could probably be factored out since it duplicates
# some functionality of apply.parsers(evaluating the sources again)
# but I am not sure how big the changes involved woud be.
#e <- new.env()
#old <- options(keep.source=TRUE,topLevelEnvironment=e)
#on.exit(options(old))
#exprs <- parse(text=code)
### set this so that no warnings about creating a fake
### package when we try to process S4 classes defined in code
#e$.packageName <- "inlinedocs.processor"
#for (i in exprs){
# eval(i, e)
#}
g=file(,open="w+")#anonymous file
showMethods(classes=name,printTo=g,where=e)
lines=readLines(g)
close(g)
ind=grep("Function",lines)
flines=lines[ind]
line2name=function(line){return(strsplit(line," ")[[1]][2])}
methodnames=as.character(lapply(flines,line2name))
markDupAliases=function(line){
ret=line
if(is.element(aliasLine2name(line),methodnames)){
ret=gsub("(^\\\\alias)","%% \\1",line)
}
return(ret)
}
for (j in aliasInd){
dlines[[j]]=markDupAliases(dlines[[j]])
}
#print(fb)
#print(d)
#print(dlines)
txt <- paste(dlines,collapse="\n")
fc=file(f,open="w+")#anonymous file
writeLines(txt,fc)
close(fc)
}
modify.Rd.file <- function
### Add inline documentation from comments to an Rd file
### automatically-generated by package.skeleton.
(N,
### Name of function/file to which we will add documentation.
pkg,
### Package name.
docs
### Named list of documentation in extracted comments.
){
# PhG: for functions like 'obj<-', package.skeleton creates files like 'obj_-'
# => rework names the same way, .e., using the same function from utils package
Nme <- fixPackageFileNames(N)
fb <- paste(Nme,".Rd",sep="")
## For some functions, such as `[[.object`, package.skeleton (as used
## within this package but not when used standalone) seems to generate
## with a preceding z ("z[[.object.Rd"), so the z form is tested for and
## used if it exists and the first does not.
zfb <- paste("z",Nme,".Rd",sep="")
f <- file.path(pkg,'man',fb)
if ( (!file.exists(f)) && file.exists(file.path(pkg,'man',zfb)) ){
fb <- zfb
f <- file.path(pkg,'man',zfb)
}
## If there are no significant docs in the comments then the object
## should still be documented, by writing the file by hand in the
## man directory. This will write a blank Rd file if none exists, so
## it's easy to get started.
if((length(docs[[N]])<3) && file.exists(file.path("..","man",fb))){
print(paste("mm object with no documentation available N=",N))
print(docs[[N]])
#writeLines(as.character(docs),con="/tmp/docs")
#stop()
unlink(f)
return()
}
d <- docs[[N]]
if (Nme =="GenericFunc_method__B_character"){
#pp("d",environment())
}
## for some functions no documentatian file is created by package.skeleton
## for instance generic functions that are already defined in other packages
## like print or plot so there is still the possibillity that
## f is missing altogether
#####################################
if (!file.exists(f)) {
#print(f)
return()
}
dlines <- readLines(f)
## cut out alias line if we are in the package file and there is a
## matching function
if(length(grep("-package$",N)) && "alias" %in% names(d) )
dlines <- dlines[-grep(paste("alias[{]",N,sep=""),dlines)-1]
else if ( "alias" %in% names(d) ){
## allowing alias changes have to make sure that original alias remains
## note that the contents of this go inside \alias{}, so the separator
## has to terminate one and start the next
d[["alias"]] <- paste(paste(N,"}\n\\alias{",sep=""),
d[["alias"]],sep="")
}
# PhG: in the special case of custom operators like %....%, we must protect
# these strings in name, alias and usage (at least)! Otherwise, bad things
# happen with these strings: (1) usage entry is cut out, because confused
# with comments, and % are escaped in name and alias!
if (grepl("^%.+%$", N)) {
Nmask <- gsub("%", "---percent---", N)
# Replace any occurence of N by Nmask
dlines <- gsub(N, Nmask, dlines, fixed = TRUE)
} else Nmask <- NULL
## cut out all comments {} interferes with regex matching
comments <- grep("^[%~]",dlines)
## gotcha! if no comment lines, then -(nothing) kills everything
if ( 0 < length(comments) ) dlines <- dlines[-comments]
## and class skeletons have a different way of using ~
dlines <- gsub("\\s*~.*~\\s*","",dlines,perl=TRUE)
## and the "Objects can be created..." boilerplate also breaks perl REs
dlines <- gsub("Objects can be created by calls.*\\)\\}","",dlines,perl=TRUE)
## ditto the "or \code{\linkS4class{CLASSNAME}} for links to other classes"
dlines <- gsub("or \\\\code\\{\\\\linkS4class.*classes","",dlines,perl=TRUE)
## cut out a couple of sections that cause warnings
o <- grep("Optionally",dlines)
if(length(o))dlines <- dlines[-(o:(o+1))]
## delete examples til the end of the file (also includes keywords)
dlines <- dlines[1:(tail(grep("examples[{]$",dlines),1)-1)]
## add back a minimal examples section to find and replace
dlines <- c(dlines,"\\examples{}\n")
## and replace keyword section if keywords are present.
if ( "keyword" %in% names(d) ){
dlines <- c(dlines,"\\keyword{}\n")
}
## erase curly braces in format section, which appear sporadically
## and can cause errors in R CMD check.
fstart <- grep("^\\\\format[{]$",dlines)+1
if(length(fstart)){
closing <- grep("^[}]$",dlines)
fend <- closing[closing>fstart][1]-1
dlines[fstart:fend] <- gsub("[{}]","",dlines[fstart:fend])
}
## sometimes (s4 classes) title is has \code{} blocks inside, which
## causes problems with our find-replace regex inside replace.one,
## so lets just put a simple title that works.
i <- grep("^\\\\title",dlines)
if(length(i)){
dlines[i] <- gsub("\\\\code[{][^}]*[}]","",dlines[i])
}
name=N
txt <- paste(dlines,collapse="\n")
## Fix usage
m <- regexpr("usage[{][^}]*[}]",txt)
Mend <- m+attr(m,"match.length")
utxt <- substr(txt,m+6,Mend-2)
## fix \method version if .s3method
if ( is.null(d$.s3method) ) {
# PhG: in case we have fun<-(x, ..., value), we must rewrite it
# as fun(x, ...) <- value
if (grepl("<-$", N)) {
utxt <- sub("<-[(](.+), ([^,)]+)[)]",
"(\\1) <- \\2", utxt)
}
# PhG: this is for special functions %...% which should write x %...% y
if (grepl("^%.*%$", N)) {
utxt <- sub("(%.*%)[(]([^,]+), ([^)]+)[)]",
"\\2 \\1 \\3", utxt)
}
}
## multiple lines for the PDF!
# tw: parse fails on accessor functions such as "myF<-" <- function(data,x)
# see testfile accessorFunctions.R
# workaround with tryCatch
parsed <- utxt
tryCatch({
parsed <- parse(text=utxt)
}, error = function(e) warning(e) )
if(length(parsed)){
utxt <- sprintf("usage{%s}\n",paste(format(parsed[[1]]),collapse="\n"))
}
if(length(grep("usage[{]data",utxt))){
utxt <- gsub("data[(]([^)]*)[)]","\\1",utxt)
}
## fix \method version if .s3method
if ( !is.null(d$.s3method) ){
pat <- paste(d$.s3method,collapse=".")
rep <- paste("\\method{xx",d$.s3method[1],"}{",d$.s3method[2],"}",sep="")
utxt <- gsub(pat,rep,utxt,fixed=TRUE)
# PhG: there is the special case of generic<-.obj(x, ..., value) to rewrite
# \method{generic}{obj}(x, ...) <- value
if (grepl("<-$", d$.s3method[1])) {
# 1) replace {generic<-} by {generic}
utxt <- sub("<-[}]", "}", utxt)
# 2) replace ..., value) by ...) <- value
utxt <- sub(", *([^),]+)[)]", ") <- \\1", utxt)
}
} else {
#tw: moved before parse
}
## package.skeleton brakes usage lines at 100 characters while
## R CMD check --as-cran complains when they are longer than
## 90 characters
utxt=.widthCutter(utxt,89)
## add another backslash due to bug in package.skeleton
## but only if not before % character due to another bug if % in usage
## arguments - see above
txt <- paste(substr(txt,1,m-1),
gsub("\\\\([^%])","\\\\\\\\\\1",utxt),
substr(txt,Mend+1,nchar(txt)),
sep="")
## At least in my code, any remaining % symbols are in \usage sections
## as function arguments. These promptly break Rd check because you end
## up with unterminated strings. Just in case, the following regexp only
## modifies those % symbols which follow something other than %.
## (a more complicated version would attempt to do so only within strings.)
txt <- gsub("([^%])%","\\1\\\\%",txt,perl=TRUE)
# PhG: now restore masked function name, if any (case of %....% operators)
if (!is.null(Nmask))
txt <- gsub(Nmask, N, txt, fixed = TRUE)
## Find and replace based on data in d
for(torep in names(d)){
if ( !grepl("^[.]",torep) ){## .flags should not be used for find-replace
txt <- replace.one(torep,d[[torep]],txt)
}
}
## delete empty sections to suppress warnings in R CMD check
txt <- gsub("\\\\[a-z]+[{]\\s*[}]","",txt)
if ( !is.null(d$.s3method) ){
## and now remove the xx inserted above to prevent \method{[[}{...} falling
## foul of the above replacement!
txt <- gsub("\\\\method{xx","\\method{",txt,fixed=TRUE)
}
## This doesn't work if there are quotes in the default values:
## gsub(",",paste("\n",paste(rep(" ",l=nchar(N)-1),collapse="")),utxt)
## convert to dos line endings to avoid problems with svn
# twutz: on windows cat automatically adds another \r before each \n
# so only add \r when running on unix
if(.Platform$OS.type == "unix")
txt <- gsub("(?<!\r)\n","\r\n",txt,perl=TRUE)
cat(txt,file=f)
cat("\n")
}
Try the inlinedocs package in your browser
Any scripts or data that you put into this service are public.
inlinedocs documentation built on May 2, 2019, 4:44 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#
# vim:set ff=unix expandtab ts=2 sw=2:
#################################################################
writePackageRdFile <- function(pkgDir,name,path){
p=file.path(".")
promptPackage(
name,
filename = file.path(path, sprintf("%s-package.Rd", name)),
lib.loc = p
)
}
#################################################################
writeFunctionRdFiles <- function(e,pkgDir,path,inlinedocs.documentNamespaceOnly){
### At the moment only empty files are written (and later filled my modify.Rd.file) although the complete information is
### already present at this stage. Future versions will finish the job right here, rendering modify.Rd file unnecassary
### but only after all the other stuff can be written directly too.
objs <- sapply(ls(e),get,e,simplify=FALSE)
funs<- objs[unlist(sapply(objs,is.function))]
# note that ls will not find S4 methods for generic functions which are treated elsewhere
if (inlinedocs.documentNamespaceOnly){
fnames<- union(
exportedFunctions(pkgDir),
exportedGenerics(pkgDir)
)
functionList <- fnames
}else{
functionList<- names(funs)
}
list0 <- fixPackageFileNames(functionList)
names(list0) <- functionList
sapply(
functionList,
function(item) {
fn <- file.path(path, paste(list0[[item]],".Rd",sep=""))
prompt(
#get(item, envir = e),
funs[[item]],
name = item,
filename = fn
)
}
)
}
#################################################################
writeClassRdFiles <- function(environment,pkgDir,path,inlinedocs.documentNamespaceOnly){
if (inlinedocs.documentNamespaceOnly){
classesList<- exportedClasses(pkgDir)
}else{
classesList<- allClasses(environment)
}
classes0 <- fixPackageFileNames(classesList)
names(classes0) <- classesList
sapply(classesList, function(item) {
methods::promptClass(item, filename = file.path(path,
sprintf("%s-class.Rd", classes0[item])), where = environment)
})
}
#################################################################
writeMethodRdFiles <- function(e,pkgDir,path,inlinedocs.documentNamespaceOnly=FALSE){
## add files that document a single method
if(inlinedocs.documentNamespaceOnly){
#gens <- exportedDocumentableMeths(e,pkgdir)
gens <- exportedDocumentableMeths(e,pkgDir)
}else{
gens <- documentableMeths(e)
}
##pp("gens",environment())
#####################################
genericFuncNames=names(gens)
for(genName in genericFuncNames){
methDefs=gens[[genName]]
for ( method in methDefs){
#method <- getMethod(genName,sig,where=e)
#src=getSource(method)
sig=methSig(method)
src=as.character(getSrcref(unRematchDefinition(method)))
N <- methodDocName(genName,sig)
# renaming of operator files like package.skeleton does
Nme <- fixPackageFileNames(N)
# check if the filename is compatible
# this can be a problem for [[ $
#pp("N",environment())
##pp("src", environment())
f=paste(Nme,".Rd",sep="")
fff <- eval(parse(text=str_split(src,"\n")))
#pe(quote(getwd()),environment())
# write docu to a list
l=prompt(fff,filename=NA)
#pp("l",environment())
l[["name"]]=paste("\\name{",N,"}",sep="")
l[["aliases"]]=paste("\\alias{",N,"}",sep="")
# in every section of the list replace fff by the name of the Generic
for (i in seq_along(l)){
l[[i]] <- gsub("fff",genName,l[[i]])
}
## Note:
## The usage section from the R generated method description causes a warning
## about a missing alias.
## For example:
## If we have a generic function exampleGen with a mehthod for Class "A"
## the "prompt" call and subsequent renameing above would set:
## l[["alias"]] <- "exampleGen-method-#A" while the usage section
## l[["usage"]] <- "exampleGen(object)"
## If this was written to the Rd file later R CMD check will WARN that it
## did not find the name used in the usage section of the file as an alias in the same file.
## "R CMD check" usually expects a usage section of the kind
## l[["usage"]] == "exampleGen-method-#A(object)" or
## l[["usage"]] == "Alias1" or
## l[["usage"]] == "Alias2" ...
## But for a mehthod of a Generic the usage section should contain the name of that Generic.
## The temptation is to set the alias to the name of the Generic,
## but this would be a disaster:
## A user typing ?exampleGen would not get either:
## - the documentation of the generic function "exampleGen" or
## - the documentation of one of the first method implementig "exampleGen"
## - the documentation of one of the second method implementig "exampleGen"
## - ...
## The last file sourced by R's help system containing an \alias{"exampleGen""}
## would be shown.
## So we could either ignore the (unfounded) WARNING or remove the usage section completely
## from the method decription (which I will do here as default)
l <- l[setdiff(names(l),"usage")]
# we can also remove the alias since we do not need it.
#l <- l[setdiff(names(l),"aliases")]
p=file.path(path,f)
cat(unlist(l), file = p, sep = "\n")
}
}
}
#################################################################
writeMethodTableRdFiles <- function(e,pkgDir,path,inlinedocs.documentNamespaceOnly=FALSE){
gens <- documentableMeths(e)
if(inlinedocs.documentNamespaceOnly){
exported=exportedDocumentableMeths(e,pkgDir)
}else{
exported=gens
}
## we only look at generic which have methods we can document
#gens <- methodTable(exprs,e)
genericFuncNames=names(gens)
for (genName in genericFuncNames){
if(is.element(genName,names(exported))){
exportedMeths <- exported[[genName]]
}else{
exportedMeths=NULL
}
l <- mmPromptMethods(
genName=genName,filename=NA,
exportedMeths=exportedMeths,
where=e
)
f=fixPackageFileNames(paste(genName,"-methods.Rd",sep=""))
#pe(quote(getwd()),environment())
p=file.path(path,f)
#pp("p",environment())
cat(unlist(l), file = p, sep = "\n")
}
}
#################################################################
package.skeleton.dx <- structure(function # Package skeleton deluxe
### Generates Rd files for a package based on R code and DESCRIPTION
### metadata. After inspecting the specified R code files to find
### inline documentation, it calls the standard package.skeleton
### function, which creates bare Rd files. The inline documentation is
### added to these Rd files and then these files are copied to
### pkgdir/man, possibly overwriting the previous files there.
(pkgdir="..",
### Package directory where the DESCRIPTION file lives. Your code
### should be in pkgdir/R. We will setwd to pkgdir/R for the duration
### of the function, then switch back to where you were previously.
parsers=NULL,
### List of Parser functions, which will be applied in sequence to
### extract documentation from your code. Default NULL means to first
### search for a definition in the variable "parsers" in
### pkgdir/R/.inlinedocs.R, if that file exists. If not, we use the
### list defined in options("inlinedocs.parsers"), if that is
### defined. If not, we use the package global default in the variable
### default.parsers.
namespace = FALSE,
### A logical indicating whether a NAMESPACE file should be generated
### for this package. If \code{TRUE}, all objects whose name starts
### with a letter, plus all S4 methods and classes are exported.
excludePattern=FALSE,
### A regular expression matching the files that are not to be
### processed e.g. because inlinedocs can not handle them yet (like
### generic function definitions)
inlinedocs.documentNamespaceOnly=FALSE,
### A boolean flag indicating if documentation is only built for exported
inlinedocs.exampleDir=file.path(pkgdir,"..","inst","tests"),
### A string pointing to the location where inlinedocs should search for external examples
inlinedocs.exampleTrunk="example.",
### A string used to identify the files containing external examples in the example directory. All file names of external examples have to start with this string
...
### Parameters to pass to Parser Functions.
){
## This causes a warning on R CMD check TDH 28 Jan 2013.
##alias< < inlinedocs
oldLocation=getwd()
chdir <- file.path(pkgdir,"R")
## adapt the possibly relative path to the examples to the new location
if (!grepl("^\\/",inlinedocs.exampleDir)){
inlinedocs.exampleDir=file.path(oldLocation,inlinedocs.exampleDir)
}
if(!file.exists(chdir))stop("need pkgdir/R, tried ",chdir)
old.wd <- setwd(chdir)
on.exit(setwd(old.wd))
# PhG: R allows for specific code to be in /unix, or /windows subdirectories
# but apparently, inlinedocs does not support this. I think it is fair to
# stop here with an explicit error message if at least one of /unix or
# /windows subdirectory is found!
# file_test(-d, ...) does the job, but I don't want to add a dependency on
# package 'utils", where it lives. So, I prefer using file.info()
if (isTRUE(file.info("unix")$isdir) || isTRUE(file.info("windows")$isdir))
stop("Platform-specific code in ./R/unix, or ./R/windows is not supported")
## Default values and required fields in DESCRIPTION file.
description.defaults <-
c("Package"="",
"Maintainer"=Sys.getenv("USER"),
"Author"=Sys.getenv("USER"),
"Version"="1.0",
"License"="GPL-3",
"Title"="a package",
"Description"="a package that does\n many things.")
## Necessary fields in DESCRIPTION, otherwise error.
fields <- names(description.defaults)
## Default DESCRIPTION, written if it doesn't exist.
empty.description <-
matrix(description.defaults,ncol=length(fields),dimnames=list(NULL,fields))
## if no DESCRIPTION, make one and exit.
descfile <- file.path("..","DESCRIPTION")
if(!file.exists(descfile)){
write.dcf(empty.description,descfile)
stop("Need ",descfile,"; please fill that in and try again")
}
## Read description and check for errors
desc <- read.dcf(descfile)
## TDH 3 Sept 2013 need to support Authors@R for CRAN.
if("Authors@R" %in% colnames(desc)){
author <- paste(eval(parse(text=desc[,"Authors@R"])), collapse=", ")
desc <- cbind(desc,
Author=author,
Maintainer=author)
}
if(any(f <- !sapply(fields,is.element,colnames(desc))))
stop("Need ", paste(names(f)[f], collapse = ", "), " in ", descfile)
#PhG: corrected from stop("Need ",names(f)[f]," in ",descfile)
if(any(f <- sapply(fields,function(f)desc[,f]=="")))
stop("Need a value for ", paste(names(f)[f], collapse = ", "),
" in ", descfile)
#PhG: corrected from stop("Need a value for ",names(f)[f]," in ",descfile)
## Load necessary packages before loading pkg code
if("Depends" %in% colnames(desc)){
required <- strsplit(desc[,"Depends"],split=",")[[1]]
# PhG: for packages with NAMESPACE, dependencies are also listes in the
# Imports field!
} else required <- character(0)
# PhG: packages listed in Imports field are not supposed to be attached to the
# search path when a package with NAMESPACE is loaded, only the namespace is
# loaded. However, the code here is not loaded as it should be, and we need to
# load also these Import(ed) packages to get correct results in the present
# case (to be checked with most complex cases!)
if ("Imports" %in% colnames(desc))
required <- c(required, strsplit(desc[, "Imports"], split = ",")[[1]])
##print(c("required=",required))
## This may need some refining, basically I just tried to take the
## first word from each vector element, stripping of whitespace in
## front and anything after:
#pkgnames <- gsub("\\W*(\\w+)\\b.*","\\1",required)
# PhG: the previous line is wrong: it does not work with package names
# like R.oo... Extract from Writing R Extensions manual:
# "The `Package' and `Version' fields give the name and the version of the
# package, respectively. The name should consist of letters, numbers, and the
# dot character and start with a letter."
# Consequently, I propose:
pkgnames <- gsub("\\W*([a-zA-Z][a-zA-Z0-9.]*)\\b.*", "\\1", required)
# PhG: We need to eliminate 'R' from the list!
pkgnames <- pkgnames[pkgnames != "R"]
# PhG: if we create a namespace, we need to keep this list for further use
if (isTRUE(namespace)) allpkgs <- pkgnames
# PhG: We eliminate also from the list the packages that are already loaded
if(length(pkgnames))
pkgnames <- pkgnames[!sprintf("package:%s",pkgnames) %in% search()]
# PhG: according to Writing R Extensions manual, a package name can occur
# several times in Depends
pkgnames <- unique(pkgnames)
if (length(pkgnames)) {
# PhG: A civilized function returns the system in the same state it was
# before => detach loaded packages at the end!
on.exit(suppressWarnings({
try(for (pkg in pkgnames)detach(paste("package", pkg, sep = ":"),
unload = TRUE, character.only = TRUE), silent = TRUE)
}), add = TRUE)
# PhG: Shouldn't we need to check that packages are loaded and shouldn't
# we exit with an explicit error message if not? Note: we don't use version
# information here. That means we may well load wrong version of the
# packages... and that is NOT detected as an error!
pkgmissing <- character(0)
for (pkg in pkgnames) {
if(!require(pkg, character.only = TRUE)){
pkgmissing <- c(pkgmissing, pkg)
}
}
if (length(pkgmissing))
stop("Need missing package(s): ", paste(pkgmissing, collapse = ", "))
}
## for the parser list, first try reading package-specific
## configuration file
if(is.null(parsers))parsers <- tryCatch({
cfg <- new.env()
sys.source(cfile <- ".inlinedocs.R",cfg)
L <- cfg$parsers
if(!is.null(L))cat("Using parsers in ",cfile,"\n",sep="")
L
},error=function(e)NULL)
## then try the global options()
opt <- "inlinedocs.parsers"
if(is.null(parsers)&&!is.null(parsers <- getOption(opt))){
cat("Using parsers in option ",opt,"\n",sep="")
}
## if nothing configured, just use the pkg default
if(is.null(parsers))parsers <- default.parsers
## concatenate code files and parse them
# PhG: in Writing R Extensions manuals, source code in /R subdirectory can
# have .R, .S, .q, .r, or .s extension. However, it makes sense to restrict
# this to .R only for inlinedocs, but a clear indication is required in the
# man page!
code_files <- if(!"Collate"%in%colnames(desc)) Sys.glob("*.R") else
strsplit(gsub("\\s+"," ",desc[,"Collate"]),split=" ")[[1]]
## TW 29 April 2015 remove single quotes surrounding the filename
# that are inserted by roxygen2 into collate field
# and that do not work with source
code_files <- sub("^'", "", sub("'$", "", code_files))
code_files =grep(excludePattern,code_files,invert=TRUE,value=TRUE)
## TDH 28 Jan 2013, warn users such as Pierre Neuvial if they have
## comments on the last line of one input file. Sometimes comments
# on the last line can appear to be the first line of comments of
## the next code file.
lines.list <- lapply(code_files,readLines)
for(i in seq_along(lines.list)){
lvec <- lines.list[[i]]
fn <- code_files[i]
last <- lvec[length(lvec)]
if(grepl("#",last)){
warning("comment on last line of ",fn,
", unexpected docs may be extracted")
}
}
#print(excludePattern)
## Make package skeleton and edit Rd files (eventually just don't
## use package.skeleton at all?)
name <- desc[,"Package"]
unlink(name,recursive=TRUE)
# # PhG: one must consider a potential Encoding field in DESCRIPTION file!
# which is used also for .R files according to Writing R Extensions
if ("Encoding" %in% colnames(desc)) {
oEnc <- options(encoding = desc[1, "Encoding"])$encoding
on.exit(options(encoding = oEnc), add = TRUE)
}
code <- do.call(c,lapply(code_files,readLines))
# #print(code)
L<- apply.parsers(code,parsers,verbose=TRUE,desc=desc,inlinedocs.exampleDir,inlinedocs.exampleTrunk)
docs <- L[["docs"]]
e <- L[["env"]]
objs <- L[["objs"]]
exprs<- L[["exprs"]]
#mm.package.skeleton(name=name,code_files=code_files,environment=e)
p=file.path(name,"man")
dir.create(p,recursive=TRUE)
f="DESCRIPTION";file.copy(file.path("..",f),file.path(name,f))
#f="NAMESPACE";file.copy(file.path("..",f),file.path(name,f))
writeFunctionRdFiles(e,pkgDir="..",path=p,inlinedocs.documentNamespaceOnly)
writeMethodTableRdFiles(e,pkgDir="..",path=p,inlinedocs.documentNamespaceOnly)
writeMethodRdFiles(e,"..",path=p,inlinedocs.documentNamespaceOnly)
writeClassRdFiles(e,pkgDir="..",path=p,inlinedocs.documentNamespaceOnly)
writePackageRdFile(pkgDir="..",name=name,path=p)
cat("Modifying files automatically generated by package.skeleton:\n")
## documentation of generics may be duplicated among source files.
dup.names <- duplicated(names(docs))
if ( any(dup.names) ){
warning("duplicated file names in docs: ",paste(names(docs)[dup.names]))
}
for(N in unique(names(docs))) {
modify.Rd.file(N,name,docs)
if(grepl("class",N)){
removeAliasesfrom.Rd.file(N,name,code,e)
}
}
file.copy(file.path(name,'man'),"..",recursive=TRUE)
# PhG: copy NAMESPACE file back
if (isTRUE(namespace)) {
# PhG: package.skeleton() does not add import() statement, but here the
# philosophy is to get a fully compilable package, which is not the
# case at this stage with a NAMESPACE. So, we add all packages listed
# in Depends and Imports fields of the DESCRIPTION file in an import()
# statement in the NAMESPACE
nmspFile <- file.path("..", "NAMESPACE")
cat("import(", paste(allpkgs, collapse = ", "), ")\n\n", sep = "",
file = nmspFile)
# PhG: append the content of the NAMESPACE file generated by
# package.skeleton()
file.append(nmspFile, file.path(name,'NAMESPACE'))
# PhG: we also have to export S3 methods explictly in the NAMESPACE
cat("\n", file = nmspFile, append = TRUE)
for (N in unique(names(docs))) {
d <- docs[[N]]
if (!is.null(d$.s3method))
cat('S3method("', d$.s3method[1], '", "', d$.s3method[2], '")\n',
sep = "", file = nmspFile, append = TRUE)
}
}
unlink(name,recursive=TRUE)
},ex=function(){
owd <- setwd(tempdir())
## get the path to the silly example package that is provided with
## package inlinedocs
testPackagePath <- file.path(system.file(package="inlinedocs"),"silly")
## copy example project to the current unlocked workspace that can
## be modified
file.copy(testPackagePath,".",recursive=TRUE)
## generate documentation .Rd files for this package
package.skeleton.dx("silly")
## check the package to see if generated documentation passes
## without WARNINGs.
if(interactive()){
cmd <- sprintf("%s CMD check --as-cran silly",file.path(R.home("bin"), "R"))
print(cmd)
checkLines <- system(cmd,intern=TRUE)
warnLines <- grep("WARNING",checkLines,value=TRUE)
if(length(warnLines)>0){
writeLines(checkLines)
cat("\n\nLines with WARNING:\n")
print(warnLines)
## disable due to bug in R CMD check:
## https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=14875
##stop("WARNING encountered in package check!")
}
}
## cleanup: remove the test package from current workspace again
unlink("silly",recursive=TRUE)
setwd(owd)
})
replace.one <- function
### Do find and replace for one element of an inner documentation list
### on 1 Rd file.
(torep,
### tag to find.
REP,
### contents of tag to put inside.
txt
### text in which to search.
){
##if(grepl("Using the same conventions",REP))browser()
# sometimes torep might be the empty string "" which would lead to emptying the
# whole textbody due to the substitution rule.
# To avoid this we check:
if (torep==""){return(txt)}
escape.backslashes <- function(x)gsub("\\\\","\\\\\\\\",x)
cat(" ",torep,sep="")
FIND1 <- escape.backslashes(torep)
##pp("FIND1",environment())
FIND <- gsub("([{}])","\\\\\\1",FIND1)
FIND <- paste(FIND,"[{][^}]*[}]",sep="")
REP.esc <- escape.backslashes(REP)
## need to escape backslashes for faithful copying of the comments
## to the Rd file:
REP <- paste(FIND1,"{",REP.esc,"}",sep="")
## escape percent signs in R code:
REP <- gsub("%","\\\\\\\\%",REP)
## alias (in particular) need to change only the first one generated
## (generic methods in classes add to standard skeleton alias set)
if ( torep %in% c("alias") ){
txt <- sub(FIND,REP,txt)
} else {
txt <- gsub(FIND,REP,txt)
}
classrep <- sub("item{(.*)}","item{\\\\code{\\1}:}",torep,perl=TRUE)
if ( classrep != torep ){
## in xxx-class files, slots are documented with:
## \item{\code{name}:}{Object of class \code{"function"} ~~ }
## which requires slightly different processing
FIND1 <- escape.backslashes(classrep)
FIND <-
paste(gsub("([{}])","\\\\\\1",FIND1),
"\\{Object of class \\\\code\\{\\\"(\\S+)\\\"\\}[^}]*[}]",sep="")
## need to escape backslashes for faithful copying of the comments
## to the Rd file and also put the class type in parentheses.
REP <- paste(FIND1,"{(\\\\code{\\1}) ",REP.esc,"}",sep="")
## escape percent signs in R code:
REP <- gsub("%","\\\\\\\\%",REP)
txt <- gsub(FIND,REP,txt)
}
txt
}
removeAliasesfrom.Rd.file <- function
### remove aliases to methodnames from the Rd file of a class
### automatically-generated by package.skeleton.
(N,
### Name of function/file to which we will add documentation.
pkg,
### Package name.
code,
### The code of the package
e
### The environment
)
{
# <mm:package.skeleton adds some duplicated aliases to the .*-class.Rd files
# to get rid of the warnings from R CMD check
# we have to delete them
# the duplicated aliases have 2 sources
Nme <- fixPackageFileNames(N)
fb <- paste(Nme,".Rd",sep="")
f <- file.path(pkg,'man',fb)
## If we do.not.generate this file, it does not exist so we need to
## do nothing to avoid errors.
if(!file.exists(f))return()
dlines <- readLines(f)
name=gsub("-class","",N)
# these we will later comment out
# now we look at all the aliases produces by package.skeleton
aliasLine2name=function(line){return(gsub("^\\\\alias\\{(.*)\\}","\\1",line))}
aliasInd <- grep("^\\\\alias.*",dlines)
# aliasnames=as.character(lapply(dlines[aliasInd],aliasLine2name))
# duplicates= intersect(methodnames,aliasnames)
if(length(aliasInd)){
# first get rid of the ${classname}-mehthod stuff
p1=paste(",",name,"-method",sep="")
# next get rid of the -mehthod stuff
patterns=c(p1,",ANY-method",",ANY",",character")
for (pattern in patterns){
dlines[aliasInd] <- gsub(pattern,"",dlines[aliasInd])
}
}
# next:
# the names of the methods implemented by the class
# which occur in all ".*-class.Rd" files
# as aliases
# to find them we ask for those methods but
# therefore have to read the the code to be documented.
# As the apply.parsers function we do this in a separate
# environment
# mm:
# This could probably be factored out since it duplicates
# some functionality of apply.parsers(evaluating the sources again)
# but I am not sure how big the changes involved woud be.
#e <- new.env()
#old <- options(keep.source=TRUE,topLevelEnvironment=e)
#on.exit(options(old))
#exprs <- parse(text=code)
### set this so that no warnings about creating a fake
### package when we try to process S4 classes defined in code
#e$.packageName <- "inlinedocs.processor"
#for (i in exprs){
# eval(i, e)
#}
g=file(,open="w+")#anonymous file
showMethods(classes=name,printTo=g,where=e)
lines=readLines(g)
close(g)
ind=grep("Function",lines)
flines=lines[ind]
line2name=function(line){return(strsplit(line," ")[[1]][2])}
methodnames=as.character(lapply(flines,line2name))
markDupAliases=function(line){
ret=line
if(is.element(aliasLine2name(line),methodnames)){
ret=gsub("(^\\\\alias)","%% \\1",line)
}
return(ret)
}
for (j in aliasInd){
dlines[[j]]=markDupAliases(dlines[[j]])
}
#print(fb)
#print(d)
#print(dlines)
txt <- paste(dlines,collapse="\n")
fc=file(f,open="w+")#anonymous file
writeLines(txt,fc)
close(fc)
}
modify.Rd.file <- function
### Add inline documentation from comments to an Rd file
### automatically-generated by package.skeleton.
(N,
### Name of function/file to which we will add documentation.
pkg,
### Package name.
docs
### Named list of documentation in extracted comments.
){
# PhG: for functions like 'obj<-', package.skeleton creates files like 'obj_-'
# => rework names the same way, .e., using the same function from utils package
Nme <- fixPackageFileNames(N)
fb <- paste(Nme,".Rd",sep="")
## For some functions, such as `[[.object`, package.skeleton (as used
## within this package but not when used standalone) seems to generate
## with a preceding z ("z[[.object.Rd"), so the z form is tested for and
## used if it exists and the first does not.
zfb <- paste("z",Nme,".Rd",sep="")
f <- file.path(pkg,'man',fb)
if ( (!file.exists(f)) && file.exists(file.path(pkg,'man',zfb)) ){
fb <- zfb
f <- file.path(pkg,'man',zfb)
}
## If there are no significant docs in the comments then the object
## should still be documented, by writing the file by hand in the
## man directory. This will write a blank Rd file if none exists, so
## it's easy to get started.
if((length(docs[[N]])<3) && file.exists(file.path("..","man",fb))){
print(paste("mm object with no documentation available N=",N))
print(docs[[N]])
#writeLines(as.character(docs),con="/tmp/docs")
#stop()
unlink(f)
return()
}
d <- docs[[N]]
if (Nme =="GenericFunc_method__B_character"){
#pp("d",environment())
}
## for some functions no documentatian file is created by package.skeleton
## for instance generic functions that are already defined in other packages
## like print or plot so there is still the possibillity that
## f is missing altogether
#####################################
if (!file.exists(f)) {
#print(f)
return()
}
dlines <- readLines(f)
## cut out alias line if we are in the package file and there is a
## matching function
if(length(grep("-package$",N)) && "alias" %in% names(d) )
dlines <- dlines[-grep(paste("alias[{]",N,sep=""),dlines)-1]
else if ( "alias" %in% names(d) ){
## allowing alias changes have to make sure that original alias remains
## note that the contents of this go inside \alias{}, so the separator
## has to terminate one and start the next
d[["alias"]] <- paste(paste(N,"}\n\\alias{",sep=""),
d[["alias"]],sep="")
}
# PhG: in the special case of custom operators like %....%, we must protect
# these strings in name, alias and usage (at least)! Otherwise, bad things
# happen with these strings: (1) usage entry is cut out, because confused
# with comments, and % are escaped in name and alias!
if (grepl("^%.+%$", N)) {
Nmask <- gsub("%", "---percent---", N)
# Replace any occurence of N by Nmask
dlines <- gsub(N, Nmask, dlines, fixed = TRUE)
} else Nmask <- NULL
## cut out all comments {} interferes with regex matching
comments <- grep("^[%~]",dlines)
## gotcha! if no comment lines, then -(nothing) kills everything
if ( 0 < length(comments) ) dlines <- dlines[-comments]
## and class skeletons have a different way of using ~
dlines <- gsub("\\s*~.*~\\s*","",dlines,perl=TRUE)
## and the "Objects can be created..." boilerplate also breaks perl REs
dlines <- gsub("Objects can be created by calls.*\\)\\}","",dlines,perl=TRUE)
## ditto the "or \code{\linkS4class{CLASSNAME}} for links to other classes"
dlines <- gsub("or \\\\code\\{\\\\linkS4class.*classes","",dlines,perl=TRUE)
## cut out a couple of sections that cause warnings
o <- grep("Optionally",dlines)
if(length(o))dlines <- dlines[-(o:(o+1))]
## delete examples til the end of the file (also includes keywords)
dlines <- dlines[1:(tail(grep("examples[{]$",dlines),1)-1)]
## add back a minimal examples section to find and replace
dlines <- c(dlines,"\\examples{}\n")
## and replace keyword section if keywords are present.
if ( "keyword" %in% names(d) ){
dlines <- c(dlines,"\\keyword{}\n")
}
## erase curly braces in format section, which appear sporadically
## and can cause errors in R CMD check.
fstart <- grep("^\\\\format[{]$",dlines)+1
if(length(fstart)){
closing <- grep("^[}]$",dlines)
fend <- closing[closing>fstart][1]-1
dlines[fstart:fend] <- gsub("[{}]","",dlines[fstart:fend])
}
## sometimes (s4 classes) title is has \code{} blocks inside, which
## causes problems with our find-replace regex inside replace.one,
## so lets just put a simple title that works.
i <- grep("^\\\\title",dlines)
if(length(i)){
dlines[i] <- gsub("\\\\code[{][^}]*[}]","",dlines[i])
}
name=N
txt <- paste(dlines,collapse="\n")
## Fix usage
m <- regexpr("usage[{][^}]*[}]",txt)
Mend <- m+attr(m,"match.length")
utxt <- substr(txt,m+6,Mend-2)
## fix \method version if .s3method
if ( is.null(d$.s3method) ) {
# PhG: in case we have fun<-(x, ..., value), we must rewrite it
# as fun(x, ...) <- value
if (grepl("<-$", N)) {
utxt <- sub("<-[(](.+), ([^,)]+)[)]",
"(\\1) <- \\2", utxt)
}
# PhG: this is for special functions %...% which should write x %...% y
if (grepl("^%.*%$", N)) {
utxt <- sub("(%.*%)[(]([^,]+), ([^)]+)[)]",
"\\2 \\1 \\3", utxt)
}
}
## multiple lines for the PDF!
# tw: parse fails on accessor functions such as "myF<-" <- function(data,x)
# see testfile accessorFunctions.R
# workaround with tryCatch
parsed <- utxt
tryCatch({
parsed <- parse(text=utxt)
}, error = function(e) warning(e) )
if(length(parsed)){
utxt <- sprintf("usage{%s}\n",paste(format(parsed[[1]]),collapse="\n"))
}
if(length(grep("usage[{]data",utxt))){
utxt <- gsub("data[(]([^)]*)[)]","\\1",utxt)
}
## fix \method version if .s3method
if ( !is.null(d$.s3method) ){
pat <- paste(d$.s3method,collapse=".")
rep <- paste("\\method{xx",d$.s3method[1],"}{",d$.s3method[2],"}",sep="")
utxt <- gsub(pat,rep,utxt,fixed=TRUE)
# PhG: there is the special case of generic<-.obj(x, ..., value) to rewrite
# \method{generic}{obj}(x, ...) <- value
if (grepl("<-$", d$.s3method[1])) {
# 1) replace {generic<-} by {generic}
utxt <- sub("<-[}]", "}", utxt)
# 2) replace ..., value) by ...) <- value
utxt <- sub(", *([^),]+)[)]", ") <- \\1", utxt)
}
} else {
#tw: moved before parse
}
## package.skeleton brakes usage lines at 100 characters while
## R CMD check --as-cran complains when they are longer than
## 90 characters
utxt=.widthCutter(utxt,89)
## add another backslash due to bug in package.skeleton
## but only if not before % character due to another bug if % in usage
## arguments - see above
txt <- paste(substr(txt,1,m-1),
gsub("\\\\([^%])","\\\\\\\\\\1",utxt),
substr(txt,Mend+1,nchar(txt)),
sep="")
## At least in my code, any remaining % symbols are in \usage sections
## as function arguments. These promptly break Rd check because you end
## up with unterminated strings. Just in case, the following regexp only
## modifies those % symbols which follow something other than %.
## (a more complicated version would attempt to do so only within strings.)
txt <- gsub("([^%])%","\\1\\\\%",txt,perl=TRUE)
# PhG: now restore masked function name, if any (case of %....% operators)
if (!is.null(Nmask))
txt <- gsub(Nmask, N, txt, fixed = TRUE)
## Find and replace based on data in d
for(torep in names(d)){
if ( !grepl("^[.]",torep) ){## .flags should not be used for find-replace
txt <- replace.one(torep,d[[torep]],txt)
}
}
## delete empty sections to suppress warnings in R CMD check
txt <- gsub("\\\\[a-z]+[{]\\s*[}]","",txt)
if ( !is.null(d$.s3method) ){
## and now remove the xx inserted above to prevent \method{[[}{...} falling
## foul of the above replacement!
txt <- gsub("\\\\method{xx","\\method{",txt,fixed=TRUE)
}
## This doesn't work if there are quotes in the default values:
## gsub(",",paste("\n",paste(rep(" ",l=nchar(N)-1),collapse="")),utxt)
## convert to dos line endings to avoid problems with svn
# twutz: on windows cat automatically adds another \r before each \n
# so only add \r when running on unix
if(.Platform$OS.type == "unix")
txt <- gsub("(?<!\r)\n","\r\n",txt,perl=TRUE)
cat(txt,file=f)
cat("\n")
}
Try the inlinedocs package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.