1#' Action button/link
2#'
3#' Creates an action button or link whose value is initially zero, and increments by one
4#' each time it is pressed.
5#'
6#' @inheritParams textInput
7#' @param label The contents of the button or link--usually a text label, but
8#'   you could also use any other HTML, like an image.
9#' @param icon An optional [icon()] to appear on the button.
10#' @param ... Named attributes to be applied to the button or link.
11#'
12#' @family input elements
13#' @examples
14#' ## Only run examples in interactive R sessions
15#' if (interactive()) {
16#'
17#' ui <- fluidPage(
18#'   sliderInput("obs", "Number of observations", 0, 1000, 500),
19#'   actionButton("goButton", "Go!", class = "btn-success"),
20#'   plotOutput("distPlot")
21#' )
22#'
23#' server <- function(input, output) {
24#'   output$distPlot <- renderPlot({
25#'     # Take a dependency on input$goButton. This will run once initially,
26#'     # because the value changes from NULL to 0.
27#'     input$goButton
28#'
29#'     # Use isolate() to avoid dependency on input$obs
30#'     dist <- isolate(rnorm(input$obs))
31#'     hist(dist)
32#'   })
33#' }
34#'
35#' shinyApp(ui, server)
36#'
37#' }
38#'
39#' ## Example of adding extra class values
40#' actionButton("largeButton", "Large Primary Button", class = "btn-primary btn-lg")
41#' actionLink("infoLink", "Information Link", class = "btn-info")
42#'
43#' @seealso [observeEvent()] and [eventReactive()]
44#'
45#' @section Server value:
46#' An integer of class `"shinyActionButtonValue"`. This class differs from
47#' ordinary integers in that a value of 0 is considered "falsy".
48#' This implies two things:
49#'   * Event handlers (e.g., [observeEvent()], [eventReactive()]) won't execute on initial load.
50#'   * Input validation (e.g., [req()], [need()]) will fail on initial load.
51#' @export
52actionButton <- function(inputId, label, icon = NULL, width = NULL, ...) {
53
54  value <- restoreInput(id = inputId, default = NULL)
55
56  tags$button(id=inputId,
57    style = css(width = validateCssUnit(width)),
58    type="button",
59    class="btn btn-default action-button",
60    `data-val` = value,
61    list(validateIcon(icon), label),
62    ...
63  )
64}
65
66#' @rdname actionButton
67#' @export
68actionLink <- function(inputId, label, icon = NULL, ...) {
69  value <- restoreInput(id = inputId, default = NULL)
70
71  tags$a(id=inputId,
72    href="#",
73    class="action-button",
74    `data-val` = value,
75    list(validateIcon(icon), label),
76    ...
77  )
78}
79
80
81# Check that the icon parameter is valid:
82# 1) Check  if the user wants to actually add an icon:
83#    -- if icon=NULL, it means leave the icon unchanged
84#    -- if icon=character(0), it means don't add an icon or, more usefully,
85#       remove the previous icon
86# 2) If so, check that the icon has the right format (this does not check whether
87# it is a *real* icon - currently that would require a massive cross reference
88# with the "font-awesome" and the "glyphicon" libraries)
89validateIcon <- function(icon) {
90  if (is.null(icon) || identical(icon, character(0))) {
91    return(icon)
92  } else if (inherits(icon, "shiny.tag") && icon$name == "i") {
93    return(icon)
94  } else {
95    stop("Invalid icon. Use Shiny's 'icon()' function to generate a valid icon")
96  }
97}
98