Nothing
#' @include list.R
#' @include string.R
#' @include roclet.R
#' @include parse.R
roxygen()
##' Substitutions of questionable characters with a hacker-joke to
##' boot.
substitutions=c(
`!`='bang',
`"`='quote',
`#`='hash',
`$`='cash', # sigil
`%`='grapes',
`&`='and',
`'`='single-quote',
`(`='open-paren',
`)`='close-paren',
`*`='star',
`+`='plus',
`,`='comma',
`-`='dash',
`.`='dot',
`/`='slash',
`:`='colon',
`;`='semi-colon',
`<`='less-than',
`=`='equals',
`>`='greater-than',
`?`='p',
`@`='asperand',
`[`='open-brace',
`\\`='backslash',
`]`='close-brace',
`^`='hat',
`_`='sub',
'`'='backtick', # let's add another ` to
# rectify syntax highlighting
# in emacs; thanks.
`{`='open-curly',
`|`='pipe',
`}`='close',
`~`='not'
)
##' \code{NULL} if empty-string.
##' @param string string to check
##' @return \code{NULL} or identity
nil.if.lambda <- function(string)
if (nchar(string)) string else NULL
##' Translate file-system-questionable characters (i.e. punctuation
##' within ASCII).
##' @param filename the filename to translate
##' @return the translated filename
translate.questionable.characters <- function(filename)
do.call(Curry(paste, collapse="-"),
strapply(filename,
pattern='([[:punct:]]|)([^[:punct:]]*|)',
function(punctuation, letters)
c(substitutions[nil.if.lambda(punctuation)],
nil.if.lambda(letters))))
#' Make an Rd roclet which parses the given files and, if specified, populates
#' the given subdirectory with Rd files; or writes to standard out. See
#' \cite{Writing R Extensions}
#' (\url{http://cran.r-project.org/doc/manuals/R-exts.pdf}) for details.
#'
#' The first paragraph of a roxygen block constitutes its description, the
#' subsequent paragraphs its details; moreover, the Rd roclet supports these
#' tags:
#'
#' \tabular{ll}{
#' Roxygen tag \tab Rd analogue\cr
#' \code{@@author} \tab \code{\\author}\cr
#' \code{@@aliases} \tab \code{\\alias, ...}\cr
#' \code{@@concept} \tab \code{\\concept}\cr
#' \code{@@example} \tab \emph{n/a}\cr
#' \code{@@examples} \tab \code{\\examples}\cr
#' \code{@@format} \tab \code{\\format}\cr
#' \code{@@keywords} \tab \code{\\keyword, ...}\cr
#' \code{@@method} \tab \code{\\method}\cr
#' \code{@@name} \tab \code{\\name}\cr
#' \code{@@note} \tab \code{\\note}\cr
#' \code{@@param} \tab \code{\\arguments{\\item, ...}}\cr
#' \code{@@references} \tab \code{\\references}\cr
#' \code{@@return} \tab \code{\\value}\cr
#' \code{@@seealso} \tab \code{\\seealso}\cr
#' \code{@@source} \tab \code{\\source}\cr
#' \code{@@title} \tab \code{\\title}\cr
#' \code{@@TODO} \tab \emph{n/a}\cr
#' \code{@@usage} \tab \code{\\usage}\cr
#' }
#'
#' \enumerate{
#' \item{\code{@@author}}{See \dQuote{2.1.1 Documenting functions} from
#' \cite{Writing R Extensions}.}
#' \item{\code{@@aliases}}{A default alias is plucked from the \code{@@name} or
#' assignee; otherwise, \code{@@alias a b ...} translates
#' to \code{\\alias{a}}, \code{\\alias{b}}, &c.
#' If you specify one alias, however, specify them all.}
#' \item{\code{@@concept}}{See \dQuote{2.8 Indices} from
#' \cite{Writing R Extensions}.}
#' \item{\code{@@example}}{Each \code{@@example} tag specifies an example file
#' relative to the package head; if the file resides in
#' \file{tests}, for instance, it will be checked with
#' \command{R CMD check}.
#' The contents of the file will
#' be concatenated under \code{\\examples{...}}.}
#' \item{\code{@@examples}}{Verbatim examples; see \dQuote{2.1.1
#' Documenting functions} from \cite{Writing R
#' Extensions}.}
#' \item{\code{@@format}}{See \dQuote{2.1.2 Documenting data sets} from
#' \cite{Writing R Extensions}.}
#' \item{\code{@@keywords}}{\code{@@keywords a b ...} translates to
#' \code{\\keyword{a}}, \code{\\keyword{b}}, &c.}
#' \item{\code{@@method}}{Use \code{@@method <generic> <class>} to document
#' S3 functions.}
#' \item{\code{@@name}}{In the absense of an explicit \code{@@name} tag, the
#' name of an assignment is plucked from the assignee.}
#' \item{\code{@@note}}{See \dQuote{2.1.1 Documenting functions} from
#' \cite{Writing R Extensions}.}
#' \item{\code{@@param}}{Each function variable should have a
#' \code{@@param <variable> <description>} specified.}
#' \item{\code{@@references}}{See \dQuote{2.1.1 Documenting functions} from
#' \cite{Writing R Extensions}.}
#' \item{\code{@@return}}{The return value of the function, or \code{NULL}.}
#' \item{\code{@@seealso}}{See \dQuote{2.1.1 Documenting functions} from
#' \cite{Writing R Extensions}.}
#' \item{\code{@@source}}{See \dQuote{2.1.2 Documenting data sets} from
#' \cite{Writing R Extensions}.}
#' \item{\code{@@title}}{A default title is plucked from the first sentence
#' of the description; that is, the first phrase ending
#' with a period, question mark or newline.
#' In the absence of a description, the title becomes
#' the \code{@@name} or assignee; lastly, it can be
#' overridden with \code{@@title}.}
#' \item{\code{@@TODO}}{Note to developers to get off their asses.}
#' \item{\code{@@usage}}{A default usage is construed from a function's formals,
#' but can be overridden with \code{@@usage} (e.g. in the case
#' of multiple functions in one Rd unit).}
#' }
#'
#' @param subdir directory into which to place the Rd files; if
#' \code{NULL}, standard out.
#' @param verbose whether to declare what we're doing in the
#' \var{subdir}
#' @return Rd roclet
#' @examples
#' #' This sentence describes the function.
#' #'
#' #' Here are the details (notice the preceding blank
#' #' line); the name, title, usage and alias will be
#' #' automatically generated.
#' #'
#' #' @@param a a parameter
#' #' @@return NULL
#' f <- function(a=1) NULL
#'
#' #' S3 functions require a @@method tag for
#' #' the time being.
#' #'
#' #' @@method specialize foo
#' #' @@param f a generic foo
#' #' @@param ... ignored
#' #' @@return The specialized foo
#' specialize.foo <- function(f, ...)
#' actually.specialize(f)
#'
#' roclet <- make.Rd.roclet('man')
#' \dontrun{roclet$parse('example.R')}
#' @export
#' @aliases name aliases title usage references concept
#' note seealso example examples keywords return author
#' make.Rd.roclet
#' @TODO param method setClass setGeneric setMethod
#' make.Rd.roclet
make.Rd.roclet <- function(subdir=NULL,
verbose=TRUE) {
register.preref.parsers(parse.value,
'name',
'aliases',
'title',
'usage',
'references',
'concept',
'note',
'seealso',
'example',
'examples',
'keywords',
'return',
'author',
'TODO',
'format',
'source')
register.preref.parsers(parse.name.description,
'param',
'method')
register.preref.parsers(parse.name,
'docType')
register.srcref.parser('setClass',
function(pivot, expression)
list(S4class=car(expression)))
register.srcref.parser('setGeneric',
function(pivot, expression)
list(S4generic=car(expression)))
register.srcref.parser('setMethod',
function(pivot, expression)
list(S4method=car(expression),
signature=cadr(expression)))
#' Translate a key and expressions into an Rd expression;
#' multiple expressions take their own braces.
#' @param key the expression's key
#' @param \dots the arguments
#' @return A string containing the key and arguments
#' in LaTeX-like gestalt.
Rd.expression <- function(key, ...)
sprintf('\\%s%s\n',
key,
Reduce.paste(function(expression)
sprintf('{%s}', trim(expression)),
c(...),
''))
#' Push the Rd-expression to standard out (or current
#' sink).
#' @param key the expression's key
#' @param \dots the arguments
#' @return \code{NULL}
parse.expression <- function(key, ...)
cat(Rd.expression(key, c(...)), file=filename, append=TRUE)
filename <- ''
reset.filename <- function()
assign.parent('filename', '', environment())
first.source.line <- function(partitum) {
srcfile <- srcfile(partitum$srcref$filename)
first.line <- car(partitum$srcref$lloc)
getSrcLines(srcfile, first.line, first.line)
}
#' What does the noop look like?
NULL.STATEMENT <- 'roxygen[[:space:]]*()'
#' Does the statement contain a noop-like?
#' @param source.line the line of source code
#' @return Whether the statement contains a noop
is.null.statement <- function(source.line)
length(grep(NULL.STATEMENT, source.line) > 0)
#' @note Doesn't work recursively!
de.tex <- function(string)
gsub('\\\\[^{]*\\{([^}]*)(}|)',
'\\1',
string,
perl=TRUE)
#' First sentence of a string, defined as first
#' period, question mark or newline.
#' @param description the string to be first-sentenced
#' @return The first sentence
first.sentence <- function(description) {
description <- de.tex(description)
r <- regexpr('[^.?\n]*(\\.(?!\\w)|\\?|\n|)',
description,
perl=TRUE)
sentence <- substr(description, r, attr(r, 'match.length'))
if (length(sentence) == 0 || is.null.string(sentence))
NULL
else {
chars <- nchar(sentence)
last.char <- substr(sentence, chars, chars)
if (last.char == '.' || last.char == '?')
sentence
else
paste(trim(sentence), '...', sep='')
}
}
#' If \code{@@title} is specified, use it; or
#' take the first sentence of the description;
#' or, lastly, take the name.
#' @param partitum the parsed elements
#' @param name the calculated name-fallback
#' @return The parsed title
parse.title <- function(partitum, name) {
if (!is.null(partitum$title))
partitum$title
else if (!is.null(first.sentence <-
first.sentence(partitum$description)))
first.sentence
else
name
}
#' Reconstruct the \name directive from amongst
#' \code{@@name}, \code{@@setMethod}, \code{@@setClass},
#' \code{@@setGeneric}, \code{@@assignee}, etc.
#' @param partitum the pre-parsed elements
#' @return \code{NULL}
parse.name <- function(partitum) {
name <- guess.name(partitum)
if (is.null(name) && !is.null(subdir)) {
filename <- partitum$srcref$filename
first.line <- car(partitum$srcref$lloc)
first.source.line <- first.source.line(partitum)
if (!is.null.statement(first.source.line))
warning(sprintf(paste('No name found for the',
'following expression in %s',
'line %s:\n `%s . . .\''),
filename,
first.line,
first.source.line),
immediate.=TRUE)
} else if (!is.null(name)) {
name <- trim(name)
if (!is.null(subdir)) {
assign.parent('filename',
file.path(subdir,
sprintf('%s.Rd',
translate.questionable.characters(name))),
environment())
if (verbose)
cat(sprintf('Writing %s to %s\n', name, filename))
unlink(filename)
}
parse.expression('name', name)
if (is.null(partitum$aliases))
parse.expression('alias', name)
}
if ((!is.null(name) || !is.null(partitum$title)) &&
!is.null(title <- parse.title(partitum, name)))
parse.expression('title', title)
}
parse.function.name <- function(partitum) {
if (!is.null(partitum$method))
Rd.expression('method',
car(partitum$method),
cadr(partitum$method))
else
partitum$assignee
}
#' Turn a list of formal arguments into a human-readable
#' function-like.
#' @param partitum the pre-parsed elements
#' @return \code{NULL}
parse.formals <- function(partitum) {
formals <- partitum$formals
if (!is.null(formals)) {
## name.defaults <- zip.c(names(formals), formals)
name.defaults <-
zip.c(names(formals),
Map(function(formal) tryCatch(toString(formal),
error=function(e) '<closure>'),
formals))
args <-
do.call(paste, c(Map(function(name.default) {
name <- car(name.default)
default <- cadr(name.default)
default <- gsubfn("\"(.*)\"",
function(x)
sprintf("\"%s\"", gsub("\"", "\\\\\"", x)),
as.character(default))
if (is.null.string(default))
name
else
sprintf('%s=%s', name, default)
},
name.defaults),
sep=', '))
parse.expression('usage',
do.call(paste,
c(as.list(strwrap
(sprintf('%s(%s)',
parse.function.name(partitum),
args),
exdent=4)),
sep='\n')))
}
}
#' Prefer explicit \code{@@usage} to a \code{@@formals} list.
#' @param partitum the pre-parsed elements
#' @return \code{NULL}
parse.usage <- function(partitum) {
if (is.null(partitum$usage))
parse.formals(partitum)
else
parse.expression('usage', partitum$usage)
}
#' Reset params; parse name and usage.
#' @param partitum the pre-parsed elements
#' @return \code{NULL}
pre.parse <- function(partitum) {
assign.parent('params', NULL, environment())
assign.parent('examples', NULL, environment())
parse.name(partitum)
parse.usage(partitum)
}
#' Parse params.
#' @param partitum the pre-parsed elements
#' @return \code{NULL}
post.parse <- function(partitum) {
parse.arguments()
parse.examples(partitum)
## Assuming the previous sink was successful;
## if not, it will destroy the sink stack.
## (Should fail if unwritable, anyway.)
reset.filename()
}
roclet <- make.roclet(parse.expression,
pre.parse,
post.parse)
roclet$register.default.parsers('references',
'note',
'author',
'seealso',
'concept',
'docType')
roclet$register.parser('return',
function(key, expressions)
parse.expression('value', expressions))
#' Split a plural into its constituent singulars.
#' @param key the singular key
#' @param expressions the plurality of expressions
#' @return \code{NULL}
parse.split <- function(key, expressions) {
expression <- strcar(expressions)
rest <- strcdr(expressions)
parse.expression(key, expression)
if (!is.null.string(rest))
parse.split(key, rest)
}
roclet$register.parser('aliases',
function(key, expressions)
parse.split('alias', expressions))
roclet$register.parser('keywords',
function(key, expressions)
parse.split('keyword', expressions))
#' Split the introductory matter into its description followed
#' by details (separated by a blank line).
#' @param key ignored
#' @param expressions the to-be-parsed description and details
#' @return \code{NULL}
parse.description <- function(key, expressions) {
paragraphs <- car(strsplit(car(expressions), '\n\n', fixed=TRUE))
description <- car(paragraphs)
details <- do.call(paste, append(cdr(paragraphs), list(sep='\n\n')))
parse.expression('description', description)
if (length(details) > 0 && !is.null.string(details))
parse.expression('details', details)
}
roclet$register.parser('description', parse.description)
params <- NULL
#' Add a parameter to the global param list.
#' @param key ignored
#' @param expression the parameter
#' @return \code{NULL}
parse.param <- function(key, expression)
assign.parent('params',
append(params, list(expression)),
environment())
#' Reduce and paste together the various parameters
#' in an Rd-readable list (with \code{\\item}s, etc.).
#' @param name.param name-param pair
#' @return A list of Rd-readable expressions
parse.params <- function()
Reduce.paste(function(name.param)
Rd.expression('item',
car(name.param),
cadr(name.param)),
params,
'')
#' Paste and label the Rd-readable expressions
#' returned by \code{parse.params}.
#' @return \code{NULL}
parse.arguments <- function()
if (length(params) > 0)
parse.expression('arguments', parse.params())
roclet$register.parser('param', parse.param)
examples <- NULL
#' Parse individual \code{@@example} clauses by adding the
#' pointed-to file to a global store.
#' @param key ignored
#' @param expression the file containing the example(s)
#' @return \code{NULL}
parse.example <- function(key, expression)
assign.parent('examples',
append(examples, expression),
environment())
#' If \code{@@examples} is provided, use that; otherwise, concatenate
#' the files pointed to by each \code{@@example}.
#' @param partitum the parsed elements
#' @return \code{NULL}
parse.examples <- function(partitum) {
if (!is.null(partitum$examples))
parse.expression('examples', partitum$examples)
else {
examples <- Reduce(c, Map(function(file)
tryCatch(readLines(trim(file)),
error=function(e) NULL),
examples),
NULL)
if (!is.null(examples))
parse.expression('examples',
do.call(paste, c(as.list(examples), sep='\n')))
}
}
roclet$register.parser('example', parse.example)
parse.todo <- function(key, value)
parse.expression('section', 'TODO', value)
roclet$register.parser('TODO', parse.todo)
roclet
}
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.