apply_tag <- function(ll, tag, class = NULL, extra_attributes = NULL) { lapply(ll, function(x) htmltools::tag(tag, c(x, class = class, extra_attributes))) } dots2list <- function(...) { # Convert dots to list, but return first element if the first element is a list # and the length of ... is 1 x <- list(...) if (length(x) == 1 && is.list(x[[1]])) return(x[[1]]) x } tag_function <- function(.tag = "div") { function(...) htmltools::tag(.tag, list(...)) } validate_value <- function(value = NULL, choices, several.ok = TRUE, value_name = "") { if (!is.null(value)) { value_name <- if (nchar(value_name) > 0) glue("`{value_name}` - ") else "" if (!several.ok && length(value) > 1) { msg <- glue("{value_name}Using the first of {length(value)} values: {value[1]}") rlang::warn(msg) value <- value[1] } not_in_choices <- setdiff(value, choices) if (length(not_in_choices)) { msg <- glue("{value_name}Ignoring invalid choices: ", "\"{paste(not_in_choices, collapse = '\", \"')}\"") rlang::warn(msg) value <- intersect(value, choices) } if (length(value)) { value } else { rlang::abort(glue("{value_name}Must be one of the following valid choices: ", "\"{paste(choices, collapse = '\", \"')}\"")) } } }