Update

Co-authored-by: Carson Sievert <cpsievert1@gmail.com>

R/bootstrap.R

@@ -91,6 +91,10 @@ getLang <- function(ui) {
 #' @export
 bootstrapLib <- function(theme = NULL) {
   tagFunction(function() {
+    if (isRunning()) {
+      setCurrentTheme(theme)
+    }
+
     # If we're not compiling Bootstrap Sass (from bslib), return the
     # static Bootstrap build.
     if (!is_bs_theme(theme)) {
@@ -112,7 +116,6 @@ bootstrapLib <- function(theme = NULL) {
     # Note also that since this is shinyOptions() (and not options()), the
     # option is automatically reset when the app (or session) exits
     if (isRunning()) {
-      setCurrentTheme(theme)
       registerThemeDependency(bs_theme_deps)
 
     } else {
@@ -1010,9 +1013,12 @@ buildTabItem <- function(index, tabsetId, foundSelected, tabs = NULL,
 
 buildNavItem <- function(divTag, tabsetId, index) {
   id <- paste("tab", tabsetId, index, sep = "-")
-  title <- tagGetAttribute(divTag, "title")
-  value <- tagGetAttribute(divTag, "data-value")
-  icon <- getIcon(iconClass = tagGetAttribute(divTag, "data-icon-class"))
+  # Get title attribute directory (not via tagGetAttribute()) so that contents
+  # don't get passed to as.character().
+  # https://github.com/rstudio/shiny/issues/3352
+  title <- divTag$attribs[["title"]]
+  value <- divTag$attribs[["data-value"]]
+  icon <- getIcon(iconClass = divTag$attribs[["data-icon-class"]])
   active <- isTabSelected(divTag)
   divTag <- tagAppendAttributes(divTag, class = if (active) "active")
   divTag$attribs$id <- id

inst/www/shared/shiny.js

@@ -3127,9 +3127,9 @@
           }
         });
         function ensureTabsetHasVisibleTab($tabset) {
-          if ($tabset.find("li.active").not(".dropdown").length === 0) {
+          var inputBinding = $tabset.data("shiny-input-binding");
+          if (!inputBinding.getValue($tabset)) {
             var destTabValue = getFirstTab($tabset);
-            var inputBinding = $tabset.data("shiny-input-binding");
             var evt = jQuery.Event("shiny:updateinput");
             evt.binding = inputBinding;
             $tabset.trigger(evt);

srcts/src/main.ts

@@ -1480,13 +1480,16 @@ function main(): void {
 
     // If the given tabset has no active tabs, select the first one
     function ensureTabsetHasVisibleTab($tabset) {
-      if ($tabset.find("li.active").not(".dropdown").length === 0) {
+      const inputBinding = $tabset.data("shiny-input-binding");
+
+      // Use the getValue() method to avoid duplicating the CSS selector
+      // for querying the DOM for the currently active tab
+      if (!inputBinding.getValue($tabset)) {
         // Note: destTabValue may be null. We still want to proceed
         // through the below logic and setValue so that the input
         // value for the tabset gets updated (i.e. input$tabsetId
         // should be null if there are no tabs).
         const destTabValue = getFirstTab($tabset);
-        const inputBinding = $tabset.data("shiny-input-binding");
         const evt = jQuery.Event("shiny:updateinput");
 
         evt.binding = inputBinding;

tests/testthat/test-tabPanel.R

@@ -96,3 +96,19 @@ test_that("tabPanelBody validates it's input", {
   expect_error(tabPanelBody(""), "single, non-empty string")
   expect_error(tabPanelBody(letters[1:2]), "single, non-empty string")
 })
+
+
+# https://github.com/rstudio/shiny/issues/3352
+test_that("tabItem titles can contain tag objects", {
+  title <- tagList(tags$i("Hello"), "world")
+  x <- tabsetPanel(tabPanel(title, "tab content"))
+  x <- renderTags(x)
+
+  # Result should contain (with different whitespace):
+  #   "<a ....> <i>Hello</i> world"
+  # As opposed to:
+  #   "<a ....>&lt;i&gt;Hello&lt;/i&gt; world
+  expect_true(
+    grepl("<a [^>]+>\\s*<i>Hello</i>\\s+world", x$html)
+  )
+})