internal_f <- function(p, f) {
stopifnot(is.character(p), length(p) == 1)
stopifnot(is.character(f), length(f) == 1)
get(f, envir = asNamespace(p))
}
"%||%" <- function(a, b) {
if (length(a) > 0) a else b
}
subs <- matrix(ncol = 2, byrow = T, c(
# Common special function names
'[<-', 'subset',
'[', 'sub',
'<-', 'set',
# Infix verbs
'!', 'not',
'&', 'and',
'|', 'or',
'*', 'times',
'+', 'plus',
'^', 'pow',
# Others
'"', 'quote',
'#', 'hash',
'$', 'cash',
'%', 'grapes',
"'", 'single-quote',
'(', 'open-paren',
')', 'close-paren',
':', 'colon',
';', 'semi-colon',
'<', 'less-than',
'==', 'equals',
'=', 'equals',
'>', 'greater-than',
'?', 'help',
'@', 'at',
']', 'close-brace',
'\\', 'backslash',
'/', 'slash',
'`', 'tick',
'{', 'open-curly',
'}', 'close',
'~', 'twiddle'
))
subs[, 2] <- paste0("-", subs[, 2], "-")
nice_name <- function(x) {
x <- stringi::stri_replace_all_fixed(x, subs[, 1], subs[, 2],
vectorize_all = FALSE)
# Clean up any remaining
x <- str_replace_all(x, "[^A-Za-z0-9_.-]+", "-")
x <- str_replace_all(x, "-+", "-")
x <- str_replace_all(x, "^-|-$", "")
x <- str_replace_all(x, "^\\.", "dot-")
x
}
write_if_different <- function(path, contents, command = NULL, check = TRUE) {
if (!file.exists(dirname(path))) {
dir.create(dirname(path), showWarnings = FALSE)
}
name <- basename(path)
if (check && !made_by_roxygen(path)) {
cli::cli_inform(c(
x = "Skipping {.href [{name}](file://{path})}",
i = "It already exists and was not generated by {.pkg roxygen2}."
))
return(FALSE)
}
line_ending <- detect_line_ending(path)
contents <- paste0(paste0(contents, collapse = line_ending), line_ending)
contents <- enc2utf8(gsub("\r?\n", line_ending, contents))
if (same_contents(path, contents)) return(FALSE)
if (!str_detect(name, "^[a-zA-Z][a-zA-Z0-9_.-]*$")) {
cli::cli_inform(c(
x = "Skipping {.path {name}}",
i = "Invalid file name"
))
FALSE
} else {
if (!is.null(command)) {
scheme <- "x-r-run"
url <- paste0(scheme, ":", command)
name <- cli::style_hyperlink(name, url)
}
cli::cli_inform("Writing {.path {name}}")
writeBin(charToRaw(contents), path)
TRUE
}
}
same_contents <- function(path, contents) {
if (length(contents) != 1) {
cli::cli_abort("`contents` must be character(1)", .internal = TRUE)
}
if (!file.exists(path)) return(FALSE)
text_hash <- cli::hash_sha256(contents)
path <- normalizePath(path, mustWork = TRUE)
file_hash <- cli::hash_file_sha256(path)
identical(text_hash, file_hash)
}
compact <- function(x) {
x[!map_lgl(x, is.null)]
}
invert <- function(x) {
if (length(x) == 0) return()
stacked <- utils::stack(x)
tapply(as.character(stacked$ind), stacked$values, list)
}
is_namespaced <- function(x) {
tryCatch({
expr <- parse_expr(x)
is_call(expr, "::", n = 2)
}, error = function(err) FALSE)
}
# Collapse the values associated with duplicated keys
collapse <- function(key, value, fun, ...) {
stopifnot(is.character(key))
stopifnot(length(key) == length(value))
dedup <- tapply(value, key, fun, ..., simplify = FALSE)
# tapply orders alphabetically, so reorder to match original order
dedup <- dedup[unique(key)]
list(
key = names(dedup),
value = unname(dedup)
)
}
cat_line <- function(...) {
cat(paste0(..., "\n", collapse = ""))
}
tag_aliases <- function(f) {
paste0("@aliases ", paste0("@", names(f()), collapse = " "))
}
pkg_env <- function() {
env <- new.env(parent = globalenv())
env$.packageName <- "roxygen2"
env
}
uuid <- function(nchar = 8) {
paste(
sample(c(letters, LETTERS, 0:9), nchar, replace = TRUE),
collapse = ""
)
}
# quoting -----------------------------------------------------------------
auto_backtick <- function(x) {
needs_backtick <- !has_quotes(x) & !is_syntactic(x)
x[needs_backtick] <- encodeString(x[needs_backtick], quote = "`")
x
}
auto_quote <- function(x) {
needs_quotes <- !has_quotes(x) & !is_syntactic(x)
x[needs_quotes] <- encodeString(x[needs_quotes], quote = '"')
x
}
is_syntactic <- function(x) make.names(x) == x
has_quotes <- function(x) str_detect(x, "^(`|'|\").*\\1$")
strip_quotes <- function(x) str_replace(x, "^(`|'|\")(.*)\\1$", "\\2")
base_packages <- function() {
if (getRversion() >= "4.4.0") {
asNamespace("tools")$standard_package_names()[["base"]]
} else {
c("base", "compiler", "datasets",
"graphics", "grDevices", "grid", "methods", "parallel",
"splines", "stats", "stats4", "tcltk", "tools", "utils"
)
}
}
# Note that this caches the result regardless of
# pkgdir! pkgdir is mainly for testing, in which case you
# need to clear the cache manually.
local_pkg_deps <- function(pkgdir = NULL) {
if (!is.null(mddata[["deps"]])) {
return(mddata[["deps"]])
}
pkgdir <- pkgdir %||% roxy_meta_get("current_package_dir")
deps <- desc::desc_get_deps(pkgdir)
deps <- deps[deps$package != "R", ]
deps <- deps[deps$type %in% c("Depends", "Imports", "Suggests"), ]
deps$package
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.