From d62a2fc1d5981d652939199f832386359de90280 Mon Sep 17 00:00:00 2001 From: Barbara Borges Ribeiro Date: Mon, 27 Mar 2017 16:51:44 +0100 Subject: [PATCH] Allow arbitrary UI code in the choiceNames for radio buttons and checkbox group input (#1521) --- NEWS.md | 4 ++ R/input-checkboxgroup.R | 51 ++++++++++++++---- R/input-radiobuttons.R | 54 ++++++++++++++----- R/input-select.R | 6 +-- R/input-utils.R | 93 ++++++++++++++++++++------------- R/update-input.R | 39 ++++++++------ man/checkboxGroupInput.Rd | 40 ++++++++++++-- man/radioButtons.Rd | 39 ++++++++++++-- man/updateCheckboxGroupInput.Rd | 27 +++++++++- man/updateRadioButtons.Rd | 27 +++++++++- tests/testthat/test-bootstrap.r | 90 +++++++++++++++++++++++++++++-- 11 files changed, 378 insertions(+), 92 deletions(-) diff --git a/NEWS.md b/NEWS.md index 83523d58ec..d9c7bfc7c9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,12 +5,16 @@ shiny 1.0.0.9001 ### Breaking changes +* The functions `radioButtons()`, `checkboxGroupInput()` and `selectInput()` (and the corresponding `updateXXX()` functions) no longer accept a `selected` argument whose value is the name of a choice, instead of the value of the choice. This feature had been deprecated since Shiny 0.10 (it printed a warning message, but still tried to match the name to the right choice) and it's now completely unsupported. + ### New features * Added `reactiveVal` function, for storing a single value which can be (reactively) read and written. Similar to `reactiveValues`, except that `reactiveVal` just lets you store a single value instead of storing multiple values by name. ([#1614](https://github.com/rstudio/shiny/pull/1614)) ### Minor new features and improvements +* Addressed [#1348](https://github.com/rstudio/shiny/issues/1348) and [#1437](https://github.com/rstudio/shiny/issues/1437) by adding two new arguments to `radioButtons()` and `checkboxGroupInput()`: `choiceNames` (list or vector) and `choiceValues` (list or vector). These can be passed in as an alternative to `choices`, with the added benefit that the elements in `choiceNames` can be arbitrary UI (i.e. anything created by `HTML()` and the `tags()` functions, like icons and images). While the underlying values for each choice (passed in through `choiceValues`) must still be simple text, their visual representation on the app (what the user actually clicks to select a different option) can be any valid HTML element. See `?radioButtons` for a small example. ([#1521](https://github.com/rstudio/shiny/pull/1521)) + * Updated `tools/README.md` with more detailed instructions. ([##1616](https://github.com/rstudio/shiny/pull/1616)) * Fixed [#1565](https://github.com/rstudio/shiny/issues/1565), which meant that resources with spaces in their names return HTTP 404. ([#1566](https://github.com/rstudio/shiny/pull/1566)) diff --git a/R/input-checkboxgroup.R b/R/input-checkboxgroup.R index 24664729ce..2122b039a3 100644 --- a/R/input-checkboxgroup.R +++ b/R/input-checkboxgroup.R @@ -6,9 +6,21 @@ #' #' @inheritParams textInput #' @param choices List of values to show checkboxes for. If elements of the list -#' are named then that name rather than the value is displayed to the user. +#' are named then that name rather than the value is displayed to the user. If +#' this argument is provided, then \code{choiceNames} and \code{choiceValues} +#' must not be provided, and vice-versa. #' @param selected The values that should be initially selected, if any. #' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally) +#' @param choiceNames,choiceValues List of names and values, respectively, +#' that are displayed to the user in the app and correspond to the each +#' choice (for this reason, \code{choiceNames} and \code{choiceValues} +#' must have the same length). If either of these arguments is +#' provided, then the other \emph{must} be provided and \code{choices} +#' \emph{must not} be provided. The advantage of using both of these over +#' a named list for \code{choices} is that \code{choiceNames} allows any +#' type of UI object to be passed through (tag objects, icons, HTML code, +#' ...), instead of just simple text. See Examples. +#' #' @return A list of HTML elements that can be added to a UI definition. #' #' @family input elements @@ -26,26 +38,47 @@ #' tableOutput("data") #' ) #' -#' server <- function(input, output) { +#' server <- function(input, output, session) { #' output$data <- renderTable({ #' mtcars[, c("mpg", input$variable), drop = FALSE] #' }, rownames = TRUE) #' } #' #' shinyApp(ui, server) +#' +#' ui <- fluidPage( +#' checkboxGroupInput("icons", "Choose icons:", +#' choiceNames = +#' list(icon("calendar"), icon("bed"), +#' icon("cog"), icon("bug")), +#' choiceValues = +#' list("calendar", "bed", "cog", "bug") +#' ), +#' textOutput("txt") +#' ) +#' +#' server <- function(input, output, session) { +#' output$txt <- renderText({ +#' icons <- paste(input$icons, collapse = ", ") +#' paste("You chose", icons) +#' }) +#' } +#' +#' shinyApp(ui, server) #' } #' @export -checkboxGroupInput <- function(inputId, label, choices, selected = NULL, - inline = FALSE, width = NULL) { +checkboxGroupInput <- function(inputId, label, choices = NULL, selected = NULL, + inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) { + + args <- normalizeChoicesArgs(choices, choiceNames, choiceValues) selected <- restoreInput(id = inputId, default = selected) - # resolve names - choices <- choicesWithNames(choices) - if (!is.null(selected)) - selected <- validateSelected(selected, choices, inputId) + # default value if it's not specified + if (!is.null(selected)) selected <- as.character(selected) - options <- generateOptions(inputId, choices, selected, inline) + options <- generateOptions(inputId, selected, inline, + 'checkbox', args$choiceNames, args$choiceValues) divClass <- "form-group shiny-input-checkboxgroup shiny-input-container" if (inline) diff --git a/R/input-radiobuttons.R b/R/input-radiobuttons.R index 72407f443b..a9279b7044 100644 --- a/R/input-radiobuttons.R +++ b/R/input-radiobuttons.R @@ -11,11 +11,22 @@ #' #' @inheritParams textInput #' @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) +#' named then that name rather than the value is displayed to the user). If +#' this argument is provided, then \code{choiceNames} and \code{choiceValues} +#' must not be provided, and vice-versa. #' @param selected The initially selected value (if not specified then -#' defaults to the first value) +#' defaults to the first value) #' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally) #' @return A set of radio buttons that can be added to a UI definition. +#' @param choiceNames,choiceValues List of names and values, respectively, +#' that are displayed to the user in the app and correspond to the each +#' choice (for this reason, \code{choiceNames} and \code{choiceValues} +#' must have the same length). If either of these arguments is +#' provided, then the other \emph{must} be provided and \code{choices} +#' \emph{must not} be provided. The advantage of using both of these over +#' a named list for \code{choices} is that \code{choiceNames} allows any +#' type of UI object to be passed through (tag objects, icons, HTML code, +#' ...), instead of just simple text. See Examples. #' #' @family input elements #' @seealso \code{\link{updateRadioButtons}} @@ -47,27 +58,46 @@ #' } #' #' shinyApp(ui, server) +#' +#' ui <- fluidPage( +#' radioButtons("rb", "Choose one:", +#' choiceNames = list( +#' icon("calendar"), +#' HTML("

Red Text

"), +#' "Normal text" +#' ), +#' choiceValues = list( +#' "icon", "html", "text" +#' )), +#' textOutput("txt") +#' ) +#' +#' server <- function(input, output) { +#' output$txt <- renderText({ +#' paste("You chose", input$rb) +#' }) +#' } +#' +#' shinyApp(ui, server) #' } #' @export -radioButtons <- function(inputId, label, choices, selected = NULL, - inline = FALSE, width = NULL) { +radioButtons <- function(inputId, label, choices = NULL, selected = NULL, + inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) { - # resolve names - choices <- choicesWithNames(choices) + args <- normalizeChoicesArgs(choices, choiceNames, choiceValues) selected <- restoreInput(id = inputId, default = selected) # default value if it's not specified - selected <- if (is.null(selected)) choices[[1]] else { - validateSelected(selected, choices, inputId) - } + selected <- if (is.null(selected)) args$choiceValues[[1]] else as.character(selected) + if (length(selected) > 1) stop("The 'selected' argument must be of length 1") - options <- generateOptions(inputId, choices, selected, inline, type = 'radio') + options <- generateOptions(inputId, selected, inline, + 'radio', args$choiceNames, args$choiceValues) divClass <- "form-group shiny-input-radiogroup shiny-input-container" - if (inline) - divClass <- paste(divClass, "shiny-input-container-inline") + if (inline) divClass <- paste(divClass, "shiny-input-container-inline") tags$div(id = inputId, style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"), diff --git a/R/input-select.R b/R/input-select.R index 72e584de8f..28117f3df1 100644 --- a/R/input-select.R +++ b/R/input-select.R @@ -74,8 +74,8 @@ #' } #' @export selectInput <- function(inputId, label, choices, selected = NULL, - multiple = FALSE, selectize = TRUE, width = NULL, - size = NULL) { + multiple = FALSE, selectize = TRUE, width = NULL, + size = NULL) { selected <- restoreInput(id = inputId, default = selected) @@ -85,7 +85,7 @@ selectInput <- function(inputId, label, choices, selected = NULL, # default value if it's not specified if (is.null(selected)) { if (!multiple) selected <- firstChoice(choices) - } else selected <- validateSelected(selected, choices, inputId) + } else selected <- as.character(selected) if (!is.null(size) && selectize) { stop("'size' argument is incompatible with 'selectize=TRUE'.") diff --git a/R/input-utils.R b/R/input-utils.R index 65eb70bd1f..4d30238f2c 100644 --- a/R/input-utils.R +++ b/R/input-utils.R @@ -2,45 +2,62 @@ controlLabel <- function(controlName, label) { label %AND% tags$label(class = "control-label", `for` = controlName, label) } - -# Before shiny 0.9, `selected` refers to names/labels of `choices`; now it -# refers to values. Below is a function for backward compatibility. It also -# coerces the value to `character`. -validateSelected <- function(selected, choices, inputId) { - # this line accomplishes two tings: - # - coerces selected to character - # - drops name, otherwise toJSON() keeps it too - selected <- as.character(selected) - # if you are using optgroups, you're using shiny > 0.10.0, and you should - # already know that `selected` must be a value instead of a label - if (needOptgroup(choices)) return(selected) - - if (is.list(choices)) choices <- unlist(choices) - - nms <- names(choices) - # labels and values are identical, no need to validate - if (identical(nms, unname(choices))) return(selected) - # when selected labels instead of values - i <- (selected %in% nms) & !(selected %in% choices) - if (any(i)) { - warnFun <- if (all(i)) { - # replace names with values - selected <- unname(choices[selected]) - warning - } else stop # stop when it is ambiguous (some labels == values) - warnFun("'selected' must be the values instead of names of 'choices' ", - "for the input '", inputId, "'") +# This function takes in either a list or vector for `choices` (and +# `choiceNames` and `choiceValues` are passed in as NULL) OR it takes +# in a list or vector for both `choiceNames` and `choiceValues` (and +# `choices` is passed as NULL) and returns a list of two elements: +# - `choiceNames` is a vector or list that holds the options names +# (each element can be arbitrary UI, or simple text) +# - `choiceValues` is a vector or list that holds the options values +# (each element must be simple text) +normalizeChoicesArgs <- function(choices, choiceNames, choiceValues, + mustExist = TRUE) { + # if-else to check that either choices OR (choiceNames + choiceValues) + # were correctly provided + if (is.null(choices)) { + if (is.null(choiceNames) || is.null(choiceValues)) { + if (mustExist) { + stop("Please specify a non-empty vector for `choices` (or, ", + "alternatively, for both `choiceNames` AND `choiceValues`).") + } else { + if (is.null(choiceNames) && is.null(choiceValues)) { + # this is useful when we call this function from `updateInputOptions()` + # in which case, all three `choices`, `choiceNames` and `choiceValues` + # may legitimately be NULL + return(list(choiceNames = NULL, choiceValues = NULL)) + } else { + stop("One of `choiceNames` or `choiceValues` was set to ", + "NULL, but either both or none should be NULL.") + } + } + } + if (length(choiceNames) != length(choiceValues)) { + stop("`choiceNames` and `choiceValues` must have the same length.") + } + if (anyNamed(choiceNames) || anyNamed(choiceValues)) { + stop("`choiceNames` and `choiceValues` must not be named.") + } + } else { + if (!is.null(choiceNames) || !is.null(choiceValues)) { + warning("Using `choices` argument; ignoring `choiceNames` and `choiceValues`.") + } + choices <- choicesWithNames(choices) # resolve names if not specified + choiceNames <- names(choices) + choiceValues <- unname(choices) } - selected -} + return(list(choiceNames = as.list(choiceNames), + choiceValues = as.list(as.character(choiceValues)))) +} # generate options for radio buttons and checkbox groups (type = 'checkbox' or # 'radio') -generateOptions <- function(inputId, choices, selected, inline, type = 'checkbox') { +generateOptions <- function(inputId, selected, inline, type = 'checkbox', + choiceNames, choiceValues, + session = getDefaultReactiveDomain()) { # generate a list of options <- mapply( - choices, names(choices), + choiceValues, choiceNames, FUN = function(value, name) { inputTag <- tags$input( type = type, name = inputId, value = value @@ -48,14 +65,18 @@ generateOptions <- function(inputId, choices, selected, inline, type = 'checkbox if (value %in% selected) inputTag$attribs$checked <- "checked" + # in case, the options include UI code other than text + # (arbitrary HTML using the tags() function or equivalent) + pd <- processDeps(name, session) + # If inline, there's no wrapper div, and the label needs a class like # checkbox-inline. if (inline) { - tags$label(class = paste0(type, "-inline"), inputTag, tags$span(name)) + tags$label(class = paste0(type, "-inline"), inputTag, + tags$span(pd$html, pd$dep)) } else { - tags$div(class = type, - tags$label(inputTag, tags$span(name)) - ) + tags$div(class = type, tags$label(inputTag, + tags$span(pd$html, pd$dep))) } }, SIMPLIFY = FALSE, USE.NAMES = FALSE diff --git a/R/update-input.R b/R/update-input.R index fa58f683b3..e434aca11e 100644 --- a/R/update-input.R +++ b/R/update-input.R @@ -452,16 +452,18 @@ updateSliderInput <- function(session, inputId, label = NULL, value = NULL, updateInputOptions <- function(session, inputId, label = NULL, choices = NULL, - selected = NULL, inline = FALSE, - type = 'checkbox') { - if (!is.null(choices)) - choices <- choicesWithNames(choices) - if (!is.null(selected)) - selected <- validateSelected(selected, choices, session$ns(inputId)) + selected = NULL, inline = FALSE, type = NULL, + choiceNames = NULL, choiceValues = NULL) { + if (is.null(type)) stop("Please specify the type ('checkbox' or 'radio')") + + args <- normalizeChoicesArgs(choices, choiceNames, choiceValues, mustExist = FALSE) + + if (!is.null(selected)) selected <- as.character(selected) - options <- if (!is.null(choices)) { + options <- if (!is.null(args$choiceValues)) { format(tagList( - generateOptions(session$ns(inputId), choices, selected, inline, type = type) + generateOptions(session$ns(inputId), selected, inline, type, + args$choiceNames, args$choiceValues) )) } @@ -510,9 +512,10 @@ updateInputOptions <- function(session, inputId, label = NULL, choices = NULL, #' } #' @export updateCheckboxGroupInput <- function(session, inputId, label = NULL, - choices = NULL, selected = NULL, - inline = FALSE) { - updateInputOptions(session, inputId, label, choices, selected, inline) + choices = NULL, selected = NULL, inline = FALSE, + choiceNames = NULL, choiceValues = NULL) { + updateInputOptions(session, inputId, label, choices, selected, + inline, "checkbox", choiceNames, choiceValues) } @@ -552,10 +555,15 @@ updateCheckboxGroupInput <- function(session, inputId, label = NULL, #' } #' @export updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL, - selected = NULL, inline = FALSE) { + selected = NULL, inline = FALSE, + choiceNames = NULL, choiceValues = NULL) { # you must select at least one radio button - if (is.null(selected) && !is.null(choices)) selected <- choices[[1]] - updateInputOptions(session, inputId, label, choices, selected, inline, type = 'radio') + if (is.null(selected)) { + if (!is.null(choices)) selected <- choices[[1]] + else if (!is.null(choiceValues)) selected <- choiceValues[[1]] + } + updateInputOptions(session, inputId, label, choices, selected, + inline, 'radio', choiceNames, choiceValues) } @@ -601,8 +609,7 @@ updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL, updateSelectInput <- function(session, inputId, label = NULL, choices = NULL, selected = NULL) { choices <- if (!is.null(choices)) choicesWithNames(choices) - if (!is.null(selected)) - selected <- validateSelected(selected, choices, inputId) + if (!is.null(selected)) selected <- as.character(selected) options <- if (!is.null(choices)) selectOptions(choices, selected) message <- dropNulls(list(label = label, options = options, value = selected)) session$sendInputMessage(inputId, message) diff --git a/man/checkboxGroupInput.Rd b/man/checkboxGroupInput.Rd index 624344b41d..ff67999083 100644 --- a/man/checkboxGroupInput.Rd +++ b/man/checkboxGroupInput.Rd @@ -4,8 +4,8 @@ \alias{checkboxGroupInput} \title{Checkbox Group Input Control} \usage{ -checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE, - width = NULL) +checkboxGroupInput(inputId, label, choices = NULL, selected = NULL, + inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) } \arguments{ \item{inputId}{The \code{input} slot that will be used to access the value.} @@ -13,7 +13,9 @@ checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE, \item{label}{Display label for the control, or \code{NULL} for no label.} \item{choices}{List of values to show checkboxes for. If elements of the list -are named then that name rather than the value is displayed to the user.} +are named then that name rather than the value is displayed to the user. If +this argument is provided, then \code{choiceNames} and \code{choiceValues} +must not be provided, and vice-versa.} \item{selected}{The values that should be initially selected, if any.} @@ -21,6 +23,16 @@ are named then that name rather than the value is displayed to the user.} \item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'}; see \code{\link{validateCssUnit}}.} + +\item{choiceNames, choiceValues}{List of names and values, respectively, +that are displayed to the user in the app and correspond to the each +choice (for this reason, \code{choiceNames} and \code{choiceValues} +must have the same length). If either of these arguments is +provided, then the other \emph{must} be provided and \code{choices} +\emph{must not} be provided. The advantage of using both of these over +a named list for \code{choices} is that \code{choiceNames} allows any +type of UI object to be passed through (tag objects, icons, HTML code, +...), instead of just simple text. See Examples.} } \value{ A list of HTML elements that can be added to a UI definition. @@ -42,12 +54,32 @@ ui <- fluidPage( tableOutput("data") ) -server <- function(input, output) { +server <- function(input, output, session) { output$data <- renderTable({ mtcars[, c("mpg", input$variable), drop = FALSE] }, rownames = TRUE) } +shinyApp(ui, server) + +ui <- fluidPage( + checkboxGroupInput("icons", "Choose icons:", + choiceNames = + list(icon("calendar"), icon("bed"), + icon("cog"), icon("bug")), + choiceValues = + list("calendar", "bed", "cog", "bug") + ), + textOutput("txt") +) + +server <- function(input, output, session) { + output$txt <- renderText({ + icons <- paste(input$icons, collapse = ", ") + paste("You chose", icons) + }) +} + shinyApp(ui, server) } } diff --git a/man/radioButtons.Rd b/man/radioButtons.Rd index affafbf467..60e4fe1c4d 100644 --- a/man/radioButtons.Rd +++ b/man/radioButtons.Rd @@ -4,8 +4,8 @@ \alias{radioButtons} \title{Create radio buttons} \usage{ -radioButtons(inputId, label, choices, selected = NULL, inline = FALSE, - width = NULL) +radioButtons(inputId, label, choices = NULL, selected = NULL, + inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) } \arguments{ \item{inputId}{The \code{input} slot that will be used to access the value.} @@ -13,7 +13,9 @@ radioButtons(inputId, label, choices, selected = NULL, inline = FALSE, \item{label}{Display label for the control, or \code{NULL} for no label.} \item{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)} +named then that name rather than the value is displayed to the user). If +this argument is provided, then \code{choiceNames} and \code{choiceValues} +must not be provided, and vice-versa.} \item{selected}{The initially selected value (if not specified then defaults to the first value)} @@ -22,6 +24,16 @@ defaults to the first value)} \item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'}; see \code{\link{validateCssUnit}}.} + +\item{choiceNames, choiceValues}{List of names and values, respectively, +that are displayed to the user in the app and correspond to the each +choice (for this reason, \code{choiceNames} and \code{choiceValues} +must have the same length). If either of these arguments is +provided, then the other \emph{must} be provided and \code{choices} +\emph{must not} be provided. The advantage of using both of these over +a named list for \code{choices} is that \code{choiceNames} allows any +type of UI object to be passed through (tag objects, icons, HTML code, +...), instead of just simple text. See Examples.} } \value{ A set of radio buttons that can be added to a UI definition. @@ -63,6 +75,27 @@ server <- function(input, output) { }) } +shinyApp(ui, server) + +ui <- fluidPage( + radioButtons("rb", "Choose one:", + choiceNames = list( + icon("calendar"), + HTML("

Red Text

"), + "Normal text" + ), + choiceValues = list( + "icon", "html", "text" + )), + textOutput("txt") +) + +server <- function(input, output) { + output$txt <- renderText({ + paste("You chose", input$rb) + }) +} + shinyApp(ui, server) } } diff --git a/man/updateCheckboxGroupInput.Rd b/man/updateCheckboxGroupInput.Rd index b1efc47065..115ec6dfc3 100644 --- a/man/updateCheckboxGroupInput.Rd +++ b/man/updateCheckboxGroupInput.Rd @@ -5,7 +5,8 @@ \title{Change the value of a checkbox group input on the client} \usage{ updateCheckboxGroupInput(session, inputId, label = NULL, choices = NULL, - selected = NULL, inline = FALSE) + selected = NULL, inline = FALSE, choiceNames = NULL, + choiceValues = NULL) } \arguments{ \item{session}{The \code{session} object passed to function given to @@ -16,11 +17,33 @@ updateCheckboxGroupInput(session, inputId, label = NULL, choices = NULL, \item{label}{The label to set for the input object.} \item{choices}{List of values to show checkboxes for. If elements of the list -are named then that name rather than the value is displayed to the user.} +are named then that name rather than the value is displayed to the user. If +this argument is provided, then \code{choiceNames} and \code{choiceValues} +must not be provided, and vice-versa.} \item{selected}{The values that should be initially selected, if any.} \item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)} + +\item{choiceNames}{List of names and values, respectively, +that are displayed to the user in the app and correspond to the each +choice (for this reason, \code{choiceNames} and \code{choiceValues} +must have the same length). If either of these arguments is +provided, then the other \emph{must} be provided and \code{choices} +\emph{must not} be provided. The advantage of using both of these over +a named list for \code{choices} is that \code{choiceNames} allows any +type of UI object to be passed through (tag objects, icons, HTML code, +...), instead of just simple text. See Examples.} + +\item{choiceValues}{List of names and values, respectively, +that are displayed to the user in the app and correspond to the each +choice (for this reason, \code{choiceNames} and \code{choiceValues} +must have the same length). If either of these arguments is +provided, then the other \emph{must} be provided and \code{choices} +\emph{must not} be provided. The advantage of using both of these over +a named list for \code{choices} is that \code{choiceNames} allows any +type of UI object to be passed through (tag objects, icons, HTML code, +...), instead of just simple text. See Examples.} } \description{ Change the value of a checkbox group input on the client diff --git a/man/updateRadioButtons.Rd b/man/updateRadioButtons.Rd index 222f74a578..44fa867b03 100644 --- a/man/updateRadioButtons.Rd +++ b/man/updateRadioButtons.Rd @@ -5,7 +5,8 @@ \title{Change the value of a radio input on the client} \usage{ updateRadioButtons(session, inputId, label = NULL, choices = NULL, - selected = NULL, inline = FALSE) + selected = NULL, inline = FALSE, choiceNames = NULL, + choiceValues = NULL) } \arguments{ \item{session}{The \code{session} object passed to function given to @@ -16,12 +17,34 @@ updateRadioButtons(session, inputId, label = NULL, choices = NULL, \item{label}{The label to set for the input object.} \item{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)} +named then that name rather than the value is displayed to the user). If +this argument is provided, then \code{choiceNames} and \code{choiceValues} +must not be provided, and vice-versa.} \item{selected}{The initially selected value (if not specified then defaults to the first value)} \item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)} + +\item{choiceNames}{List of names and values, respectively, +that are displayed to the user in the app and correspond to the each +choice (for this reason, \code{choiceNames} and \code{choiceValues} +must have the same length). If either of these arguments is +provided, then the other \emph{must} be provided and \code{choices} +\emph{must not} be provided. The advantage of using both of these over +a named list for \code{choices} is that \code{choiceNames} allows any +type of UI object to be passed through (tag objects, icons, HTML code, +...), instead of just simple text. See Examples.} + +\item{choiceValues}{List of names and values, respectively, +that are displayed to the user in the app and correspond to the each +choice (for this reason, \code{choiceNames} and \code{choiceValues} +must have the same length). If either of these arguments is +provided, then the other \emph{must} be provided and \code{choices} +\emph{must not} be provided. The advantage of using both of these over +a named list for \code{choices} is that \code{choiceNames} allows any +type of UI object to be passed through (tag objects, icons, HTML code, +...), instead of just simple text. See Examples.} } \description{ Change the value of a radio input on the client diff --git a/tests/testthat/test-bootstrap.r b/tests/testthat/test-bootstrap.r index 29c9201e63..004218fbbc 100644 --- a/tests/testthat/test-bootstrap.r +++ b/tests/testthat/test-bootstrap.r @@ -28,22 +28,43 @@ test_that("Repeated names for selectInput and radioButtons choices", { format(x) )) - - # Radio buttons + # Radio buttons using choices x <- radioButtons('id','label', choices = c(a='x1', a='x2', b='x3')) choices <- x$children - expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[2]]$children[[1]], 'a') + expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[2]]$children[[1]], HTML('a')) expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$value, 'x1') expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$checked, 'checked') - expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[2]]$children[[1]], 'a') + expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[2]]$children[[1]], HTML('a')) expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$value, 'x2') expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$checked, NULL) - expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[2]]$children[[1]], 'b') + expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[2]]$children[[1]], HTML('b')) expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$value, 'x3') expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$checked, NULL) + + # Radio buttons using choiceNames and choiceValues + x <- radioButtons('id','label', + choiceNames = list(icon('calendar'), HTML('

Red

'), 'Normal'), + choiceValues = list('icon', 'html', 'text') + ) + choices <- x$children + + expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[2]]$children[[1]], + HTML('')) + expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$value, 'icon') + expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$checked, 'checked') + + expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[2]]$children[[1]], + HTML('

Red

')) + expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$value, 'html') + expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$checked, NULL) + + expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[2]]$children[[1]], + HTML('Normal')) + expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$value, 'text') + expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$checked, NULL) }) @@ -167,3 +188,62 @@ test_that("selectInput selects items by default", { selectInput('x', 'x', list("a", "b"), multiple = TRUE) )) }) + +test_that("normalizeChoicesArgs does its job", { + + # Unnamed vectors and lists + expected <- list(choiceNames = list("a", "b"), choiceValues = list("a", "b")) + expect_equal(normalizeChoicesArgs(c("a", "b"), NULL, NULL), expected) + expect_equal(normalizeChoicesArgs(list("a", "b"), NULL, NULL), expected) + + # Named list + expected <- list(choiceNames = list("one", "two"), choiceValues = list("a", "b")) + x <- list(one = "a", two = "b") + expect_equal(normalizeChoicesArgs(x, NULL, NULL), expected) + expect_equal(normalizeChoicesArgs(NULL, names(x), unname(x)), expected) + + # Using unnamed `choiceNames` and `choiceValues` vectors/lists directly + expect_equal(normalizeChoicesArgs(NULL, c("one", "two"), c("a", "b")), expected) + expect_equal(normalizeChoicesArgs(NULL, list("one", "two"), list("a", "b")), expected) + + # Numbers + expected <- list(choiceNames = list("a", "b"), choiceValues = list("1", "2")) + expect_equal(normalizeChoicesArgs(c("a" = 1, "b" = 2), NULL, NULL), expected) + expect_equal(normalizeChoicesArgs(list("a" = 1, "b" = 2), NULL, NULL), expected) + expect_equal(normalizeChoicesArgs(NULL, c("a", "b"), c(1, 2)), expected) + expect_equal(normalizeChoicesArgs(NULL, list("a", "b"), list("1", "2")), expected) + + # Using choiceNames with HTML and choiceValues + nms <- list(icon("calendar"), HTML("

Red Text

")) + vals <- list("a", "b") + expected <- list(choiceNames = nms, choiceValues = vals) + expect_equal(normalizeChoicesArgs(NULL, nms, vals), expected) + + # Attempt to use choices, AND choiceNames + choiceValues + x <- list("a", "b") + expect_warning(res <- normalizeChoicesArgs(x, nms, vals), + "Using `choices` argument; ignoring `choiceNames` and `choiceValues`.") + expect_equal(res, list(choiceNames = list("a", "b"), choiceValues = list("a", "b"))) + + # Set possibilities to character(0) + expected <- list(choiceNames = list(), choiceValues = list()) + expect_equal(normalizeChoicesArgs(character(0), NULL, NULL), expected) + expect_equal(normalizeChoicesArgs(NULL, character(0), character(0)), expected) + expect_warning(res <- normalizeChoicesArgs(character(0), character(0), character(0)), + "Using `choices` argument; ignoring `choiceNames` and `choiceValues`.") + expect_equal(res, expected) + + # Set possibilities to NULL in an inconsistent way + expected <- paste("One of `choiceNames` or `choiceValues` was set to NULL,", + "but either both or none should be NULL.") + expect_error(normalizeChoicesArgs(NULL, character(0), NULL, FALSE), expected, fixed = TRUE) + expect_error(normalizeChoicesArgs(NULL, NULL, character(0), FALSE), expected, fixed = TRUE) + expected <- paste("Please specify a non-empty vector for `choices` (or,", + "alternatively, for both `choiceNames` AND `choiceValues`).") + expect_error(normalizeChoicesArgs(NULL, character(0), NULL), expected, fixed = TRUE) + expect_error(normalizeChoicesArgs(NULL, NULL, character(0)), expected, fixed = TRUE) + + # Set all possibilities to NULL (and mustExist = FALSE) + expected <- list(choiceNames = NULL, choiceValues = NULL) + expect_equal(normalizeChoicesArgs(NULL, NULL, NULL, FALSE), expected) +})