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 } map_arg <- function(x, .f, .args = NULL) { mapply(.f, x, MoreArgs = .args, SIMPLIFY = FALSE, USE.NAMES = TRUE) } 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) && length(value)) { value_name <- if (nchar(value_name) > 0) glue("`{value_name}` - ") else "" warnings <- c() not_in_choices <- setdiff(value, choices) if (length(not_in_choices)) { warnings <- glue("{value_name}Ignoring invalid choices: ", "\"{paste(not_in_choices, collapse = '\", \"')}\"") value <- intersect(value, choices) } if (!several.ok && length(value) > 1) { warnings <- c( warnings, glue("{value_name}Using the first of {length(value)} values: {value[1]}") ) value <- value[1] } if (length(value)) { if (length(warnings)) { rlang::warn(paste(warnings, collapse = "\n")) } value } else { rlang::abort(glue("{value_name}Must be one of the following valid choices: ", "\"{paste(choices, collapse = '\", \"')}\"")) } } else if (!is.null(value) && !length(value)) NULL } is_html <- function(x) inherits(class(x), "html") is_tagList <- function(x) inherits(class(x), "shiny.tag.list") is_tag <- function(x) inherits(class(x), "shiny.tag") is_htmlish <- function(x) is_html(x) | is_tag(x) | is_tagList(x) c_is <- function(x) { if (is.null(x)) return(NULL) str_trim(paste("is-", x, sep = "", collapse = " ")) } c_has <- function(x) { if (is.null(x)) return(NULL) str_trim(paste("has-", x, sep = "", collapse = " ")) } c_prefix <- function(x = NULL, prefix = NULL) { if (is.null(x)) return(NULL) paste0(prefix, x) } str_trim <- function(x) { x <- gsub("^\\s*|\\s*$", "", x) gsub("\\s+", " ", x) } #' Font Awesome Icon #' #' Create the correct Font Awesome class. #' @param name Name of the Font Awesome icon #' @param solid Should the solid or the regular icon be used? #' @param as_html If `FALSE` (default), only the icon class is returned. #' @examples #' fa_icon("github") #' fa_icon("star") #' fa_icon("star", FALSE) #' #' @references #' @export fa_icon <- function(name, solid = TRUE, as_html = FALSE) { iconClass <- if (name %in% font_awesome_brands) "fab" else { if (solid) "fas" else "far" } iconClass <- paste(iconClass, paste0("fa-", name)) if (!as_html) return(iconClass) icon <- tag_function("i")(class = iconClass) htmltools::htmlDependencies(icon) <- rmarkdown::html_dependency_font_awesome() icon }