#' Generate a Basic Term List Template
#'
#' Generates a basic template for a term list. Optionally prints to an external
#' file.
#'
#' @param categories A vector of categories (names corresponding to the regexes).
#' @param path Path to external term list.
#' @param hierarchical logical. If \code{TRUE} the term list is made to be
#' hierarchical.
#' @param overwrite logical. If \code{TRUE} prior files by that name will be
#' overwritten, otherwise R will prompt the user before overwritting.
#' @param copy2clip logical. If code{TRUE} uses \code{\link[clipr]{write_clip}}
#' to copy the output to the clipboard. This argument can be set globally by
#' setting \code{options(termco.copy2clip = TRUE)}.
#' @param \ldots ignored.
#' @export
#' @examples
#' cats <- c("Summons", "Justification", "Exclamation", "Empty")
#' term_list_template(cats, path = '')
#' term_list_template(cats, hierarchical = FALSE, path = '')
term_list_template <- function(categories = NULL, path = 'models/categories.R',
hierarchical = TRUE, overwrite = FALSE, copy2clip = getOption("termco.copy2clip"), ...) {
if (!is.null(path) && path != '' && dirname(path) != '.' && !dir.exists(dirname(path))) {
dir.create(dirname(path), recursive = TRUE)
}
if (!is.null(path) && path == Sys.getenv("R_HOME")) stop("path can not be `R_HOME`")
if (!is.null(path) && file.exists(path)) {
message(paste0("\"", path, "\" already exists:\nDo you want to overwrite?\n"))
ans <- utils::menu(c("Yes", "No"))
if (ans == "2") {
stop("template write aborted")
} else {
unlink(path, recursive = TRUE, force = FALSE)
}
}
if (is.null(copy2clip)) copy2clip <- FALSE
if (isTRUE(hierarchical)) {spc <- ' '} else {spc <- ' '}
if (!is.null(categories)) {
categories <- paste(sprintf('%s%s = c()', spc, categories), collapse = ',\n')
} else {
categories <- ''
}
if (isTRUE(hierarchical)) {
x <- sprintf(hierarchical_template, categories)
} else {
x <- sprintf(nonhierarchical_template, categories)
}
if (!is.null(path)) {
cat(x, '\n', file = path)
}
if (isTRUE(copy2clip)) {
clipr::write_clip(x)
}
## print out object of class term_list_template
class(x) <- 'term_list_template'
x
}
#' Prints a term_list_template Object
#'
#' Prints a term_list_template object
#'
#' @param x A term_list_template object.
#' @param \ldots ignored.
#' @method print term_list_template
#' @export
print.term_list_template <- function(x, ...){
cat(x, '\n')
}
hierarchical_template <- paste(c("list(", "## Tier 1", " list(", "%s ", " ),",
"", "## Tier 2", " list(", "", " )", ")"), collapse = '\n')
nonhierarchical_template <- paste(c("list(", "%s", ")"), collapse = '\n')
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.