updatePickerInput option disabled

R/input-selectpicker.R

@@ -5,8 +5,11 @@
 #'
 #' @param inputId The \code{input} slot that will be used to access the value.
 #' @param label Display a text in the center of the switch.
-#' @param choices List of values to select from. If elements of the list are named then that name rather than the value is displayed to the user.
-#' @param selected The initially selected value (or multiple values if multiple = TRUE). If not specified then defaults to the first value for single-select lists and no values for multiple select lists.
+#' @param choices List of values to select from. If elements of the
+#'  list are named then that name rather than the value is displayed to the user.
+#' @param selected The initially selected value (or multiple values if multiple = TRUE).
+#' If not specified then defaults to the first value for single-select lists
+#'  and no values for multiple select lists.
 #' @param multiple Is selection of multiple items allowed?
 #' @param options Options to customize the select picker
 #' @param choicesOpt Options for choices in the dropdown menu
@@ -86,14 +89,91 @@ pickerInput <- function(inputId, label = NULL, choices, selected = NULL, multipl
 #' @param session The session object passed to function given to shinyServer.
 #' @param inputId	The id of the input object.
 #' @param label Display a text in the center of the switch.
-#' @param choices List of values to select from. If elements of the list are named then that name rather than the value is displayed to the user.
-#' @param selected The initially selected value (or multiple values if multiple = TRUE). If not specified then defaults to the first value for single-select lists and no values for multiple select lists.
+#' @param choices List of values to select from. If elements of the list are named
+#' then that name rather than the value is displayed to the user.
+#' @param selected The initially selected value (or multiple values if multiple = TRUE).
+#'  If not specified then defaults to the first value for single-select lists
+#'  and no values for multiple select lists.
 #' @param choicesOpt Options for choices in the dropdown menu
 #'
 #' @importFrom utils capture.output
 #' @export
-
-
+#'
+#' @examples
+#' \dontrun{
+#' if (interactive()) {
+#'
+#' library("shiny")
+#' library("shinyWidgets")
+#'
+#' ui <- fluidPage(
+#'   tags$h2("Update pickerInput"),
+#'
+#'   fluidRow(
+#'     column(
+#'       width = 5, offset = 1,
+#'       pickerInput(
+#'         inputId = "p1",
+#'         label = "classic update",
+#'         choices = rownames(mtcars)
+#'       )
+#'     ),
+#'     column(
+#'       width = 5,
+#'       pickerInput(
+#'         inputId = "p2",
+#'         label = "disabled update",
+#'         choices = rownames(mtcars)
+#'       )
+#'     )
+#'   ),
+#'
+#'   fluidRow(
+#'     column(
+#'       width = 10, offset = 1,
+#'       sliderInput(
+#'         inputId = "up",
+#'         label = "Select between models with mpg greater than :",
+#'         width = "50%",
+#'         min = min(mtcars$mpg),
+#'         max = max(mtcars$mpg),
+#'         value = min(mtcars$mpg),
+#'         step = 0.1
+#'       )
+#'     )
+#'   )
+#'
+#' )
+#'
+#' server <- function(input, output, session) {
+#'
+#'   observeEvent(input$up, {
+#'     mtcars2 <- mtcars[mtcars$mpg >= input$up, ]
+#'
+#'     # Method 1
+#'     updatePickerInput(session = session, inputId = "p1",
+#'                       choices = rownames(mtcars2))
+#'
+#'     # Method 2
+#'     disabled_choices <- !rownames(mtcars) %in% rownames(mtcars2)
+#'     updatePickerInput(
+#'       session = session, inputId = "p2",
+#'       choices = rownames(mtcars),
+#'       choicesOpt = list(
+#'         disabled = disabled_choices,
+#'         style = ifelse(disabled_choices,
+#'                        yes = "color: rgba(119, 119, 119, 0.5);",
+#'                        no = "")
+#'       )
+#'     )
+#'   }, ignoreInit = TRUE)
+#'
+#' }
+#'
+#' shinyApp(ui = ui, server = server)
+#'
+#' }
+#' }
 updatePickerInput <- function (session, inputId, label = NULL, selected = NULL, choices = NULL, choicesOpt = NULL) {
   choices <- if (!is.null(choices))
     choicesWithNames(choices)
@@ -109,6 +189,13 @@ updatePickerInput <- function (session, inputId, label = NULL, selected = NULL,
 
 
 
+#' Generate pickerInput options
+#'
+#' @param choices a named list
+#' @param selected selected value if any
+#' @param choicesOpt additional option ofr choices
+#'
+#' @noRd
 pickerOptions <- function (choices, selected = NULL, choicesOpt = NULL)
 {
   if (is.null(choicesOpt))
@@ -141,6 +228,7 @@ pickerOptions <- function (choices, selected = NULL, choicesOpt = NULL)
         `data-icon` = choicesOpt$icon[i],
         `data-subtext` = choicesOpt$subtext[i],
         `data-content` = choicesOpt$content[i],
+        disabled = if (!is.null(choicesOpt$disabled[i]) && choicesOpt$disabled[i]) "disabled",
         selected = if (choice %in% selected) "selected" else NULL
       )
       # optionTag$attribs <- c(optionTag$attribs, list(if (choice %in% selected) " selected" else ""))

inst/examples/shinyWidgets/server.R

@@ -124,7 +124,10 @@ function(input, output, session) {
   })
 
 
-  # Update mamterialSwitch ----
+
+
+
+  # Update materialSwitch ----
   output$resupMaterial <- renderPrint({
     input$upMaterial
   })
@@ -135,7 +138,12 @@ function(input, output, session) {
     updateMaterialSwitch(session = session, inputId = "upMaterial", value = FALSE)
   })
 
-  # Update mamterialSwitch ----
+
+
+
+
+
+  # Update PickerInput ----
   output$resuppickerIcons <- renderPrint({
     input$uppickerIcons
   })