diff --git a/R/input-selectpicker.R b/R/input-selectpicker.R index 9d3b6f26..e821fd05 100644 --- a/R/input-selectpicker.R +++ b/R/input-selectpicker.R @@ -300,25 +300,40 @@ pickerSelectOptions <- function(choices, selected = NULL, choicesOpt = NULL, max } # From shiny/input-select.R, faster alternative if no choice options specific to picker -selectOptions <- function(choices, selected = NULL) { - html <- mapply(choices, names(choices), FUN = function(choice, label) { - if (is.list(choice)) { - sprintf( - '\n%s\n', - htmlEscape(label, TRUE), - selectOptions(choice, selected) - ) +selectOptions <- function(choices, + selected = NULL){ - } else { - sprintf( - '', - htmlEscape(choice, TRUE), - if (choice %in% selected) ' selected' else '', - htmlEscape(label) - ) - } - }) - HTML(paste(html, collapse = '\n')) -} + # initial vector to store output character strings + html <- vector("character", length(choices)) + + # indicating where to update list elements + is_list_choice <- vapply(choices, is.list, logical(1L)) + + # apply function ON list choices and add back to html + if(any(is_list_choice)){ + list_choices <- choices[is_list_choice] + list_html <- sprintf( + fmt = '\n%s\n', + htmltools::htmlEscape(text = names(list_choices), + attribute = TRUE), + vapply(list_choices, selectOptions, character(1L), selected = selected) + ) + html[is_list_choice] <- list_html + } + # run on just vector choices and put back into html + if(any(!is_list_choice)){ + vec_choices <- choices[!is_list_choice] + vec_html <- sprintf( + fmt = '', + htmltools::htmlEscape(text = vec_choices, + attribute = TRUE), + c("", " selected")[(vec_choices %in% selected) + 1], + htmltools::htmlEscape(names(vec_choices)) + ) + html[!is_list_choice] <- vec_html + } + # paste everything together + htmltools::HTML(paste(html, collapse = "\n")) +}