Nothing
#' Provide File \command{make.R}
#'
#' @param path Where to create the file.
#' @param Rbuildignore Add the file to \file{.Rbuildignore} under the given
#' \code{path}?
#' @param ... Arguments passed to
#' \code{\link[packager:use_template]{packager::use_template}}.
#' @return \code{\link[=invisible]{Invisibly}}
#' \code{\link[=logical]{TRUE}} on success,
#' \code{\link[=invisible]{Invisibly}}
#' \code{\link[=logical]{FALSE}} otherwise.
#' @keywords internal
#' @export
provide_make <- function(path, Rbuildignore = TRUE, ...) {
status <- use_template("make.R", pkg = path, ignore = Rbuildignore, ...)
return(status)
}
#' Use a Template
#'
#' The \pkg{devtools}' or, later \pkg{usethis}' function hardcoded the source
#' package, it had dialogs on opened files in RStudio. Did Stuff I do not want.
#'
#' @param template The name of the package's template (a file in the template
#' directory).
#' @param save_as The path where the template should be written to.
#' @param data A named list of information used to render the new file from the
#' template, typically the output of
#' \code{\link[devtools:as.package]{as.package}}.
#' @param ignore Add the new file to \file{.Rbuildignore}?
#' @param git_commit Add the new file to git and commit?
#' @param pkg The path to the package template shall be used for.
#' @param source_package The name of the package from which the template should
#' be read.
#' @param force Overwrite an existing file?
#' @return \code{\link{TRUE}} on success, \code{\link{FALSE}} otherwise.
#' @keywords internal
#' @export
use_template <- function(template, save_as = template, data = list(),
ignore = FALSE, pkg = ".",
source_package = "packager",
git_commit = TRUE,
force = isTRUE(getOption("packager")[["force"]])) {
status <- FALSE
checkmate::qassert(template, "S1")
checkmate::qassert(save_as, "S1")
checkmate::qassert(data, "L")
checkmate::qassert(source_package, "S1")
checkmate::qassert(ignore, "B1")
checkmate::qassert(git_commit, "B1")
checkmate::qassert(force, "B1")
pkg <- as.package(pkg)
checkmate::assert_class(pkg, "package")
path <- file.path(pkg$path, save_as)
if (!file.exists(path) || isTRUE(force)) {
template_path <- system.file("templates", template,
package = source_package, mustWork = TRUE
)
template_out <- whisker::whisker.render(
readLines(template_path),
data
)
message("* Creating `", save_as, "` from template.")
writeLines(template_out, path)
if (isTRUE(ignore)) {
message("* Adding `", save_as, "` to `.Rbuildignore`.")
use_build_ignore(save_as, pkg = pkg)
}
if (isTRUE(git_commit)) {
try({
if (isTRUE(ignore)) {
gert::git_add(repo = pkg[["path"]], ".Rbuildignore")
}
gert::git_add(repo = pkg[["path"]], save_as)
git_commit(path = pkg[["path"]], paste0("Adding `", save_as, "` from template `",
template, "` of package` ", source_package,
"`."))
})
}
status <- TRUE
} else {
warning("`", save_as, "` already exists.", call. = FALSE)
}
return(invisible(status))
}
#' Mark Lints by Name Suffix
#'
#' I often use internals from other packages and save them in files
#' named ..._internals..., ..._verbatim... or ..._modified... .
#' \cr I want these to be marked in \pkg{lintr}'s output.
#'
#' @param x A list of lints.
#' @param file_name_markers Parts of the file name which mark copied code.
#' @param sort Sort by file name suffix?
#' @param invert Invert the sorting?
#' @return The list of lints with names marked.
#' @keywords internal
#' @export
mark_lints <- function(x, sort = TRUE, invert = FALSE,
file_name_markers = c("_internals", "_verbatim", "_modified")
) {
mark <- "COPY:"
nomark <- "NO COPY:"
pattern <- paste0("(",
paste0("^.*", file_name_markers, ".*$",
collapse = "|"),
")")
set_mark <- function(x) {
if (grepl(pattern, x$filename))
x$mark <- mark
else
x$mark <- nomark
return(x)
}
x <- lapply(x, function(x) {
set_mark(x)
}
)
if (length(x) > 0) {
if (isTRUE(sort)) {
marked <- sapply(x, function(x) return(x[["mark"]] == mark))
if (isTRUE(invert))
x <- c(x[marked], x[! marked])
else
x <- c(x[! marked], x[marked])
}
invisible(lapply(x, print_lint))
}
return(invisible(x))
}
#' @note \code{print_lints} is an old, stale name for \code{mark_lints}.
#' @export
#' @rdname mark_lints
print_lints <- mark_lints
#' Is a Directory an R Package Root Directory?
#'
#' Just a convenience wrapper to
#' \code{\link[rprojroot:criteria]{rprojroot::is_r_package}}.
#' @param path The path to the directory.
#' @return TRUE if the directory is an \R package root directory.
#' @keywords internal
#' @export
is_r_package <-
rprojroot::as.root_criterion(rprojroot::is_r_package)[["testfun"]][[1]]
#' Create a Package's Archive Path From the Package's \file{DESCRIPTION}
#'
#' The archive file does not have to exist. Use
#' \code{file.exists(get_pkg_archive_path())} to test existence.
#' @template package_path
#' @param absolute Return the absolute path?
#' @return Path to the package's archive file.
#' @export
#' @examples
#' package_path <- file.path(tempdir(), "anRpackage")
#' usethis::create_package(path = package_path)
#' print(tarball <- get_pkg_archive_path(package_path))
#' file.exists(tarball)
get_pkg_archive_path <- function(path = ".", absolute = TRUE) {
pkg <- as.package(path)
tgz <- normalizePath(file.path(pkg$path,
paste0(pkg$package, "_",
pkg$version, ".tar.gz")),
mustWork = FALSE)
if (! isTRUE(absolute)) tgz <- sub(paste0(getwd(), "/"), "", tgz)
return(tgz)
}
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.