|
-
- 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 = '\", \"')}\""))
- }
- }
- }
|