#' Get or set entries in the pattern dictionary
#'
#' This function allows the user to get or set entries in the pattern
#' dictionary, a library of regular expressions whose elements can be referred
#' to by name in \code{\link{ore}}, and therefore easily reused.
#'
#' @param ... One or more strings or dictionary keys. Unnamed, literal strings
#' will be returned unmodified, named strings will be added to the
#' dictionary, and unquoted names will be resolved using the dictionary.
#' @param enclos Enclosure for resolving names not present in the dictionary.
#' Passed to \code{\link[base]{eval}}.
#' @return If no arguments are provided, the whole dictionary is returned.
#' Otherwise the return value is a (possibly named) character vector of
#' resolved strings.
#'
#' @examples
#' # Literal strings are returned as-is
#' ore_dict("protocol")
#'
#' # Named arguments are added to the dictionary
#' ore_dict(protocol="\\w+://")
#'
#' # ... and can be retrieved by name
#' ore_dict(protocol)
#'
#' @seealso \code{\link{ore}}, which passes its arguments through this function
#' @aliases ore.dict
#' @export ore.dict ore_dict
ore_dict <- ore.dict <- function (..., enclos = parent.frame())
{
if (!exists("dictionary", .Workspace))
.Workspace$dictionary <- list()
args <- eval(substitute(list(...)), .Workspace$dictionary, enclos=enclos)
names <- sapply(substitute(list(...)), as.character)[-1]
if (length(args) == 0)
return (.Workspace$dictionary)
else
{
valid <- sapply(args, function(x) is.character(x) && length(x) == 1)
if (any(!valid))
{
warning("Patterns that do not consist of a single string will be ignored")
args <- args[valid]
}
if (!is.null(names(args)))
{
indices <- which(names(args) != "")
.Workspace$dictionary[names(args)[indices]] <- args[indices]
names[indices] <- names(args)[indices]
}
# Most likely the argument includes a function call
if (is.list(names) || length(names) != length(args))
names <- NULL
else
{
names[unlist(args) == names | is.na(match(names,names(.Workspace$dictionary)))] <- ""
if (all(names == ""))
names <- NULL
}
result <- unlist(args)
names(result) <- names
return (result)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.