Fix front-end action button label updating logic (#4242)

* Close #4239: fix front-end action button label updating logic (follow up to #3996)

* Update news

* Use a separator instead of putting markup in attributes

* `yarn build` (GitHub Actions)

* Address feedback

* Cleanup

* Refactor into a single method to split icon/label

* `yarn build` (GitHub Actions)

* Better naming

* Add some padding to the separator

* Add some unit tests for R logic

* Update NEWS.md

* Update NEWS.md

* Update NEWS.md

* Update NEWS.md

* Increase backcompat (keep same R structure when no icon is provided)

* Refine comment

---------

Co-authored-by: cpsievert <[email protected]>

Author: cpsievert

DESCRIPTION

@@ -202,6 +202,7 @@ Collate:
     'test.R'
     'update-input.R'
     'utils-lang.R'
+    'utils-tags.R'
     'version_bs_date_picker.R'
     'version_ion_range_slider.R'
     'version_jquery.R'

NEWS.md

@@ -1,8 +1,17 @@
 # shiny (development version)
 
+## New features
+
+* The `icon` argument of `actionButton()`, `downloadButton()`, etc. now accepts values other than `shiny::icon()` (like `fontawesome::fa()` and `bsicons::bs_icon()`). (#4242)
+
+## Improvements
+
+* Padding is now provided between the `icon` and `label` of an `actionButton()`. (#4242)
 ## Bug fixes
 
-* Fixed a regression in v1.11.0 where `InputBinding`'s that didn't pass a value to their `subscribe` callback where to no longer working. (#4243)
+* Fixed a regression in v1.11.0 where `InputBinding` implementations that don't pass a value to their `subscribe` callback were no longer notifying Shiny of input changes. (#4243)
+
+* `updateActionButton()` and `updateActionLink()` once again handle `label` updates correctly (which can now include HTML). (#4242)
 
 # shiny 1.11.0
 

R/input-action.R

@@ -56,13 +56,14 @@ actionButton <- function(inputId, label, icon = NULL, width = NULL,
 
   value <- restoreInput(id = inputId, default = NULL)
 
-  tags$button(id=inputId,
+  tags$button(
+    id = inputId,
     style = css(width = validateCssUnit(width)),
-    type="button",
-    class="btn btn-default action-button",
+    type = "button",
+    class = "btn btn-default action-button",
     `data-val` = value,
     disabled = if (isTRUE(disabled)) NA else NULL,
-    list(validateIcon(icon), label),
+    get_action_children(label, icon),
     ...
   )
 }
@@ -72,30 +73,52 @@ actionButton <- function(inputId, label, icon = NULL, width = NULL,
 actionLink <- function(inputId, label, icon = NULL, ...) {
   value <- restoreInput(id = inputId, default = NULL)
 
-  tags$a(id=inputId,
-    href="#",
-    class="action-button",
+  tags$a(
+    id = inputId,
+    href = "#",
+    class = "action-button",
     `data-val` = value,
-    list(validateIcon(icon), label),
+    get_action_children(label, icon),
     ...
   )
 }
 
+get_action_children <- function(label, icon) {
+  icon <- validateIcon(icon)
 
-# Check that the icon parameter is valid:
-# 1) Check  if the user wants to actually add an icon:
-#    -- if icon=NULL, it means leave the icon unchanged
-#    -- if icon=character(0), it means don't add an icon or, more usefully,
-#       remove the previous icon
-# 2) If so, check that the icon has the right format (this does not check whether
-# it is a *real* icon - currently that would require a massive cross reference
-# with the "font-awesome" and the "glyphicon" libraries)
+  if (length(icon) > 0) {
+    # The separator elements helps us distinguish between the icon and label
+    # when dynamically updating the button/link. Ideally, we would wrap each
+    # in a container element, but is currently done with a separator to help
+    # minimize the chance of breaking existing code.
+    tagList(
+      icon,
+      tags$span(class = "shiny-icon-separator"),
+      label
+    )
+  } else {
+    # Technically, we don't need the `icon` here, but keeping it maintains
+    # backwards compatibility of `btn$children[[1]][[2]]` to get the label.
+    # The shinyGovstyle package is at least one example of this.
+    tagList(icon, label)
+  }
+}
+
+# Throw an informative warning if icon isn't html-ish
 validateIcon <- function(icon) {
-  if (is.null(icon) || identical(icon, character(0))) {
-    return(icon)
-  } else if (inherits(icon, "shiny.tag") && icon$name == "i") {
+  if (length(icon) == 0) {
     return(icon)
-  } else {
-    stop("Invalid icon. Use Shiny's 'icon()' function to generate a valid icon")
   }
+
+  if (!isTagLike(icon)) {
+    rlang::warn(
+      c(
+        "It appears that a non-HTML value was provided to `icon`.",
+        i = "Try using a `shiny::icon()` (or an equivalent) to get an icon."
+      ),
+      class = "shiny-validate-icon"
+    )
+  }
+
+  icon
 }

R/update-input.R

@@ -181,10 +181,9 @@ updateCheckboxInput <- function(session = getDefaultReactiveDomain(), inputId, l
 updateActionButton <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, icon = NULL, disabled = NULL) {
   validate_session_object(session)
 
-  if (!is.null(icon)) icon <- as.character(validateIcon(icon))
   message <- dropNulls(list(
     label = if (!is.null(label)) processDeps(label, session),
-    icon = icon,
+    icon = if (!is.null(icon)) processDeps(validateIcon(icon), session),
     disabled = disabled
   ))
   session$sendInputMessage(inputId, message)

R/utils-tags.R

@@ -0,0 +1,21 @@
+# Check if `x` is a tag(), tagList(), or HTML()
+# @param strict If `FALSE`, also consider a normal list() of 'tags' to be a tag list.
+isTagLike <- function(x, strict = FALSE) {
+  isTag(x) || isTagList(x, strict = strict) || isTRUE(attr(x, "html"))
+}
+
+isTag <- function(x) {
+  inherits(x, "shiny.tag")
+}
+
+isTagList <- function(x, strict = TRUE) {
+  if (strict) {
+    return(inherits(x, "shiny.tag.list"))
+  }
+
+  if (!is.list(x)) {
+    return(FALSE)
+  }
+
+  all(vapply(x, isTagLike, logical(1)))
+}