Add select=FALSE argument to insert/append/prependTab

R/insert-tab.R

@@ -33,6 +33,8 @@
 #' @param position Should \code{tab} be added before or after the
 #'   \code{target} tab?
 #'
+#' @param select Should \code{tab} be selected upon being inserted?
+#'
 #' @param session The shiny session within which to call this function.
 #'
 #' @seealso \code{\link{showTab}}
@@ -111,11 +113,12 @@
 #' }
 #' @export
 insertTab <- function(inputId, tab, target,
-                      position = c("before", "after"),
+                      position = c("before", "after"), select = FALSE,
                       session = getDefaultReactiveDomain()) {
   force(inputId)
   force(target)
   position <- match.arg(position)
+  force(select)
   force(session)
 
   # Barbara -- August 2017
@@ -135,7 +138,8 @@ insertTab <- function(inputId, tab, target,
       divTag = processDeps(item$divTag, session),
       menuName = NULL,
       target = target,
-      position = position)
+      position = position,
+      select = select)
   }
   session$onFlushed(callback, once = TRUE)
 }
@@ -154,10 +158,11 @@ insertTab <- function(inputId, tab, target,
 #'
 #' @rdname insertTab
 #' @export
-prependTab <- function(inputId, tab, menuName = NULL,
+prependTab <- function(inputId, tab, select = FALSE, menuName = NULL,
                        session = getDefaultReactiveDomain()) {
   force(inputId)
   force(tab)
+  force(select)
   force(menuName)
   force(session)
 
@@ -171,17 +176,19 @@ prependTab <- function(inputId, tab, menuName = NULL,
       divTag = processDeps(item$divTag, session),
       menuName = menuName,
       target = NULL,
-      position = "after")
+      position = "after",
+      select = select)
   }
   session$onFlushed(callback, once = TRUE)
 }
 
 #' @rdname insertTab
 #' @export
-appendTab <- function(inputId, tab, menuName = NULL,
+appendTab <- function(inputId, tab, select = FALSE, menuName = NULL,
                       session = getDefaultReactiveDomain()) {
   force(inputId)
   force(tab)
+  force(select)
   force(menuName)
   force(session)
 
@@ -195,7 +202,8 @@ appendTab <- function(inputId, tab, menuName = NULL,
       divTag = processDeps(item$divTag, session),
       menuName = menuName,
       target = NULL,
-      position = "before")
+      position = "before",
+      select = select)
   }
   session$onFlushed(callback, once = TRUE)
 }

R/shiny.R

@@ -1493,7 +1493,7 @@ ShinySession <- R6Class(
       )
     },
     sendInsertTab = function(inputId, liTag, divTag, menuName,
-                             target, position) {
+                             target, position, select) {
       private$sendMessage(
         `shiny-insert-tab` = list(
           inputId = inputId,
@@ -1501,7 +1501,8 @@ ShinySession <- R6Class(
           divTag = divTag,
           menuName = menuName,
           target = target,
-          position = position
+          position = position,
+          select = select
         )
       )
     },

inst/www/shared/shiny.js

@@ -1381,9 +1381,11 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
 
       // Unless the item is being prepended/appended, the target tab
       // must be provided
+      var target = null;
+      var $targetLiTag = null;
       if (message.target !== null) {
-        var target = getTargetTabs($tabset, $tabContent, message.target);
-        var $targetLiTag = target.$liTag;
+        target = getTargetTabs($tabset, $tabContent, message.target);
+        $targetLiTag = target.$liTag;
       }
 
       // If the item is to be placed inside a navbarMenu (dropdown),
@@ -1410,12 +1412,28 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       }
 
       // actually insert the item into the right place
-      if (message.prepend) $tabset.prepend($liTag);else if (message.append) $tabset.append($liTag);else if (message.position === "before") $targetLiTag.before($liTag);else if (message.position === "after") $targetLiTag.after($liTag);
+      if (message.position === "before") {
+        if ($targetLiTag) {
+          $targetLiTag.before($liTag);
+        } else {
+          $tabset.append($liTag);
+        }
+      } else if (message.position === "after") {
+        if ($targetLiTag) {
+          $targetLiTag.after($liTag);
+        } else {
+          $tabset.prepend($liTag);
+        }
+      }
       $tabContent.append($divTag);
 
       exports.renderContent($liTag[0], $liTag.html());
       exports.renderContent($divTag[0], $divTag.html());
 
+      if (message.select) {
+        $liTag.find("a").tab("show");
+      }
+
       /* Barbara -- August 2017
       Note: until now, the number of tabs in a tabsetPanel (or navbarPage
       or navlistPanel) was always fixed. So, an easy way to give an id to

srcjs/shinyapp.js

@@ -817,6 +817,10 @@ var ShinyApp = function() {
     exports.renderContent($liTag[0], $liTag.html());
     exports.renderContent($divTag[0], $divTag.html());
 
+    if (message.select) {
+      $liTag.find("a").tab("show");
+    }
+
     /* Barbara -- August 2017
     Note: until now, the number of tabs in a tabsetPanel (or navbarPage
     or navlistPanel) was always fixed. So, an easy way to give an id to