mirror of
https://github.com/rstudio/shiny.git
synced 2026-04-07 03:00:20 -04:00
refactored code and made insertion of navbarMenus possible
This commit is contained in:
Barbara Borges Ribeiro
267
R/bootstrap.R
267
R/bootstrap.R
@@ -402,6 +402,7 @@ navbarPage <- function(title,
|
||||
#' @export
|
||||
navbarMenu <- function(title, ..., menuName = title, icon = NULL) {
|
||||
structure(list(title = title,
|
||||
menuName = menuName,
|
||||
tabs = list(...),
|
||||
iconClass = iconClass(icon)),
|
||||
class = "shiny.navbarmenu")
|
||||
@@ -760,189 +761,117 @@ navlistPanel <- function(...,
|
||||
}
|
||||
|
||||
|
||||
buildTabset <- function(tabs, ulClass, textFilter = NULL,
|
||||
id = NULL, selected = NULL) {
|
||||
markTabAsSelected <- function(x) {
|
||||
attr(x, "selected") <- TRUE
|
||||
x
|
||||
}
|
||||
isTabSelected <- function(x) isTRUE(attr(x, "selected", exact = TRUE))
|
||||
containsSelectedTab <- function(tabs) any(vapply(tabs, isTabSelected, logical(1)))
|
||||
|
||||
# This function proceeds in two phases. First, it scans over all the items
|
||||
# to find and mark which tab should start selected. Then it actually builds
|
||||
# the tab nav and tab content lists.
|
||||
findAndMarkSelectedTab <- function(tabs, selected, foundSelectedItem) {
|
||||
tabs <- lapply(tabs, function(divTag) {
|
||||
if (foundSelectedItem || is.character(divTag)) { # strings are not selectable items
|
||||
|
||||
# Mark an item as selected
|
||||
markSelected <- function(x) {
|
||||
attr(x, "selected") <- TRUE
|
||||
x
|
||||
}
|
||||
} else if (inherits(divTag, "shiny.navbarmenu")) {
|
||||
res <- findAndMarkSelectedTab(divTag$tabs, selected, foundSelectedItem)
|
||||
divTag$tabs <- res$tabs
|
||||
foundSelectedItem <<- res$foundSelectedItem
|
||||
|
||||
# Returns TRUE if an item is selected
|
||||
isSelected <- function(x) {
|
||||
isTRUE(attr(x, "selected", exact = TRUE))
|
||||
}
|
||||
|
||||
# Returns TRUE if a list of tab items contains a selected tab, FALSE
|
||||
# otherwise.
|
||||
containsSelected <- function(tabs) {
|
||||
any(vapply(tabs, isSelected, logical(1)))
|
||||
}
|
||||
|
||||
# Take a pass over all tabs, and mark the selected tab.
|
||||
foundSelectedItem <- FALSE
|
||||
findAndMarkSelected <- function(tabs, selected) {
|
||||
lapply(tabs, function(divTag) {
|
||||
if (foundSelectedItem) {
|
||||
# If we already found the selected tab, no need to keep looking
|
||||
|
||||
} else if (is.character(divTag)) {
|
||||
# Strings don't represent selectable items
|
||||
|
||||
} else if (inherits(divTag, "shiny.navbarmenu")) {
|
||||
# Navbar menu
|
||||
divTag$tabs <- findAndMarkSelected(divTag$tabs, selected)
|
||||
} else { # Regular tab item
|
||||
if (is.null(selected)) {
|
||||
foundSelectedItem <<- TRUE
|
||||
divTag <- markTabAsSelected(divTag) # mark first available item
|
||||
|
||||
} else {
|
||||
# Regular tab item
|
||||
if (is.null(selected)) {
|
||||
# If selected tab isn't specified, mark first available item
|
||||
# as selected.
|
||||
tabValue <- divTag$attribs$`data-value` %OR% divTag$attribs$title
|
||||
if (identical(selected, tabValue)) { # If selected tab is specified, check for match
|
||||
foundSelectedItem <<- TRUE
|
||||
divTag <- markSelected(divTag)
|
||||
|
||||
} else {
|
||||
# If selected tab is specified, check for a match
|
||||
tabValue <- divTag$attribs$`data-value` %OR% divTag$attribs$title
|
||||
if (identical(selected, tabValue)) {
|
||||
foundSelectedItem <<- TRUE
|
||||
divTag <- markSelected(divTag)
|
||||
}
|
||||
divTag <- markTabAsSelected(divTag)
|
||||
}
|
||||
}
|
||||
|
||||
return(divTag)
|
||||
})
|
||||
}
|
||||
|
||||
|
||||
# Append an optional icon to an aTag
|
||||
appendIcon <- function(aTag, iconClass) {
|
||||
if (!is.null(iconClass)) {
|
||||
# for font-awesome we specify fixed-width
|
||||
if (grepl("fa-", iconClass, fixed = TRUE))
|
||||
iconClass <- paste(iconClass, "fa-fw")
|
||||
aTag <- tagAppendChild(aTag, icon(name = NULL, class = iconClass))
|
||||
}
|
||||
aTag
|
||||
return(divTag)
|
||||
})
|
||||
return(list(tabs = tabs, foundSelectedItem = foundSelectedItem))
|
||||
}
|
||||
|
||||
# Returns the icon object (or NULL if none) provided either a tabPanel, or the icon class
|
||||
getIcon <- function(tab = NULL, iconClass = tab$attribs$`data-icon-class`) {
|
||||
if (!is.null(iconClass)) {
|
||||
# for font-awesome we specify fixed-width
|
||||
if (grepl("fa-", iconClass, fixed = TRUE)) iconClass <- paste(iconClass, "fa-fw")
|
||||
icon(name = NULL, class = iconClass)
|
||||
} else NULL
|
||||
}
|
||||
|
||||
# Text filter for navbarMenu's (plain text) separators
|
||||
navbarMenuTextFilter <- function(text) {
|
||||
if (grepl("^\\-+$", text)) tags$li(class = "divider")
|
||||
else tags$li(class = "dropdown-header", text)
|
||||
}
|
||||
|
||||
# This function is called internally by navbarPage, tabsetPanel and navlistPanel
|
||||
buildTabset <- function(tabs, ulClass, textFilter = NULL, id = NULL, selected = NULL, foundSelectedItem = FALSE) {
|
||||
res <- findAndMarkSelectedTab(tabs, selected, foundSelectedItem)
|
||||
tabs <- res$tabs
|
||||
foundSelectedItem <- res$foundSelectedItem
|
||||
|
||||
if (!is.null(id)) ulClass <- paste(ulClass, "shiny-tab-input") # add input class if we have an id
|
||||
if (anyNamed(tabs)) {
|
||||
nms <- names(tabs)
|
||||
nms <- nms[nzchar(nms)]
|
||||
stop("Tabs should all be unnamed arguments, but some are named: ", paste(nms, collapse = ", "))
|
||||
}
|
||||
tabsetId <- p_randomInt(1000, 10000)
|
||||
tabs <- lapply(seq_len(length(tabs)), buildTabItem,
|
||||
tabsetId = tabsetId, foundSelectedItem = foundSelectedItem, tabs = tabs, textFilter = textFilter)
|
||||
|
||||
# Build the tabset
|
||||
build <- function(tabs, ulClass, textFilter = NULL, id = NULL) {
|
||||
# add tab input sentinel class if we have an id
|
||||
if (!is.null(id))
|
||||
ulClass <- paste(ulClass, "shiny-tab-input")
|
||||
tabNavList <- tags$ul( class = ulClass, id = id, `data-tabsetid` = tabsetId, lapply(tabs, "[[", 1))
|
||||
tabContent <- tags$div(class = "tab-content", `data-tabsetid` = tabsetId, lapply(tabs, "[[", 2))
|
||||
list(navList = tabNavList, content = tabContent)
|
||||
}
|
||||
|
||||
if (anyNamed(tabs)) {
|
||||
nms <- names(tabs)
|
||||
nms <- nms[nzchar(nms)]
|
||||
stop("Tabs should all be unnamed arguments, but some are named: ",
|
||||
paste(nms, collapse = ", "))
|
||||
# Builds tabPanel/navbarMenu items (this function used to be declared inside the buildTabset()
|
||||
# function and it's been refactored for clarity and reusability). Called internally by buildTabset.
|
||||
buildTabItem <- function(index, tabsetId, foundSelectedItem, tabs = NULL, divTag = NULL, textFilter = NULL) {
|
||||
divTag <- if (!is.null(divTag)) divTag else tabs[[index]]
|
||||
|
||||
# check for text; pass it to the textFilter or skip it if there is none
|
||||
if (is.character(divTag) && !is.null(textFilter)) {
|
||||
liTag <- textFilter(divTag)
|
||||
divTag <- NULL
|
||||
|
||||
} else if (inherits(divTag, "shiny.navbarmenu")) {
|
||||
# build the child tabset
|
||||
tabset <- buildTabset(divTag$tabs, "dropdown-menu", navbarMenuTextFilter, foundSelectedItem = foundSelectedItem)
|
||||
liTag <- tags$li(
|
||||
# If this navbar menu contains a selected item, mark it as active
|
||||
class = paste0("dropdown", if (containsSelectedTab(divTag$tabs)) " active"),
|
||||
tags$a(href = "#", class = "dropdown-toggle", `data-toggle` = "dropdown",
|
||||
`data-menuName` = divTag$menuName,
|
||||
divTag$title, tags$b(class = "caret"),
|
||||
getIcon(iconClass = divTag$iconClass)
|
||||
),
|
||||
tabset$navList
|
||||
)
|
||||
divTag <- tabset$content$children # list of tab content divs from the child tabset
|
||||
|
||||
} else { # Standard tabPanel item
|
||||
tabId <- paste("tab", tabsetId, index, sep = "-")
|
||||
liTag <- tags$li(tags$a(
|
||||
href = paste("#", tabId, sep = ""), `data-toggle` = "tab",
|
||||
`data-value` = divTag$attribs$`data-value`,
|
||||
divTag$attribs$title,
|
||||
getIcon(iconClass = divTag$attribs$`data-icon-class`)
|
||||
))
|
||||
if (isTabSelected(divTag)) { # If this tab is selected, mark both tags as active
|
||||
liTag$attribs$class <- "active"
|
||||
divTag$attribs$class <- "tab-pane active"
|
||||
}
|
||||
|
||||
tabsetId <- p_randomInt(1000, 10000)
|
||||
tabNavList <- tags$ul(class = ulClass, id = id, `data-tabsetid` = tabsetId)
|
||||
tabContent <- tags$div(class = "tab-content", `data-tabsetid` = tabsetId)
|
||||
|
||||
tabId <- 1
|
||||
|
||||
buildItem <- function(divTag) {
|
||||
# check for text; pass it to the textFilter or skip it if there is none
|
||||
if (is.character(divTag)) {
|
||||
if (!is.null(textFilter)) {
|
||||
tabNavList <<- tagAppendChild(tabNavList, textFilter(divTag))
|
||||
}
|
||||
|
||||
} else if (inherits(divTag, "shiny.navbarmenu")) {
|
||||
|
||||
# create the a tag
|
||||
aTag <- tags$a(href="#",
|
||||
class="dropdown-toggle",
|
||||
`data-toggle`="dropdown")
|
||||
|
||||
# add optional icon
|
||||
aTag <- appendIcon(aTag, divTag$iconClass)
|
||||
|
||||
# add the title and caret
|
||||
aTag <- tagAppendChild(aTag, divTag$title)
|
||||
aTag <- tagAppendChild(aTag, tags$b(class="caret"))
|
||||
|
||||
# build the dropdown list element
|
||||
liTag <- tags$li(class = "dropdown", aTag)
|
||||
|
||||
# text filter for separators
|
||||
textFilter <- function(text) {
|
||||
if (grepl("^\\-+$", text))
|
||||
tags$li(class="divider")
|
||||
else
|
||||
tags$li(class="dropdown-header", text)
|
||||
}
|
||||
|
||||
# build the child tabset
|
||||
tabset <- build(divTag$tabs, "dropdown-menu", textFilter)
|
||||
liTag <- tagAppendChild(liTag, tabset$navList)
|
||||
|
||||
# If this navbar menu contains a selected item, mark it as active
|
||||
if (containsSelected(divTag$tabs)) {
|
||||
liTag$attribs$class <- paste(liTag$attribs$class, "active")
|
||||
}
|
||||
|
||||
tabNavList <<- tagAppendChild(tabNavList, liTag)
|
||||
# don't add a standard tab content div, rather add the list of tab
|
||||
# content divs that are contained within the tabset
|
||||
tabContent <<- tagAppendChildren(tabContent,
|
||||
list = tabset$content$children)
|
||||
|
||||
} else {
|
||||
# Standard navbar item
|
||||
# compute id and assign it to the div
|
||||
thisId <- paste("tab", tabsetId, tabId, sep="-")
|
||||
divTag$attribs$id <- thisId
|
||||
tabId <<- tabId + 1
|
||||
|
||||
tabValue <- divTag$attribs$`data-value`
|
||||
|
||||
# create the a tag
|
||||
aTag <- tags$a(href=paste("#", thisId, sep=""),
|
||||
`data-toggle` = "tab",
|
||||
`data-value` = tabValue)
|
||||
|
||||
# append optional icon
|
||||
aTag <- appendIcon(aTag, divTag$attribs$`data-icon-class`)
|
||||
|
||||
# add the title
|
||||
aTag <- tagAppendChild(aTag, divTag$attribs$title)
|
||||
|
||||
# create the li tag
|
||||
liTag <- tags$li(aTag)
|
||||
|
||||
# If selected, set appropriate classes on li tag and div tag.
|
||||
if (isSelected(divTag)) {
|
||||
liTag$attribs$class <- "active"
|
||||
divTag$attribs$class <- "tab-pane active"
|
||||
}
|
||||
|
||||
divTag$attribs$title <- NULL
|
||||
|
||||
# append the elements to our lists
|
||||
tabNavList <<- tagAppendChild(tabNavList, liTag)
|
||||
tabContent <<- tagAppendChild(tabContent, divTag)
|
||||
}
|
||||
}
|
||||
|
||||
lapply(tabs, buildItem)
|
||||
list(navList = tabNavList, content = tabContent)
|
||||
divTag$attribs$id <- tabId
|
||||
divTag$attribs$title <- NULL
|
||||
}
|
||||
|
||||
|
||||
# Finally, actually invoke the functions to do the processing.
|
||||
tabs <- findAndMarkSelected(tabs, selected)
|
||||
build(tabs, ulClass, textFilter, id)
|
||||
return(list(liTag = liTag, divTag = divTag))
|
||||
}
|
||||
|
||||
|
||||
|
||||
134
R/insert-tab.R
134
R/insert-tab.R
@@ -1,35 +1,24 @@
|
||||
|
||||
getIcon <- function(tab) {
|
||||
iconClass <- tab$attribs$`data-icon-class`
|
||||
if (!is.null(iconClass)) {
|
||||
# for font-awesome we specify fixed-width
|
||||
if (grepl("fa-", iconClass, fixed = TRUE))
|
||||
iconClass <- paste(iconClass, "fa-fw")
|
||||
icon(name = NULL, class = iconClass)
|
||||
} else NULL
|
||||
}
|
||||
|
||||
#' Dynamically insert/remove a tabPanel
|
||||
#'
|
||||
#' Dynamically insert or remove a \code{\link{tabPanel}} from an existing
|
||||
#' \code{\link{tabsetPanel}}, \code{\link{navlistPanel}} or
|
||||
#' \code{\link{tabsetPanel}}, \code{\link{navlistPanel}} or
|
||||
#' \code{\link{navbarPage}}.
|
||||
#'
|
||||
#' When you want to insert a new tab before of after an existing tab, you
|
||||
#'
|
||||
#' When you want to insert a new tab before of after an existing tab, you
|
||||
#' should use \code{insertTab}. When you want to prepend a tab (i.e. add a
|
||||
#' tab to the beginning of the \code{tabsetPanel}), use \code{prependTab}.
|
||||
#' When you want to append a tab (i.e. add a tab to the end of the
|
||||
#' When you want to append a tab (i.e. add a tab to the end of the
|
||||
#' \code{tabsetPanel}), use \code{appendTab}.
|
||||
#'
|
||||
#' For \code{navbarPage}, you can insert/remove conventional
|
||||
#'
|
||||
#' For \code{navbarPage}, you can insert/remove conventional
|
||||
#' \code{tabPanel}s (whether at the top level or nested inside a
|
||||
#' \code{navbarMenu}), as well as an entire \code{\link{navbarMenu}}.
|
||||
#' For the latter case, \code{target} should be the \code{menuName} that
|
||||
#' you gave your \code{navbarMenu} when you first created it (by default,
|
||||
#' \code{navbarMenu}), as well as an entire \code{\link{navbarMenu}}.
|
||||
#' For the latter case, \code{target} should be the \code{menuName} that
|
||||
#' you gave your \code{navbarMenu} when you first created it (by default,
|
||||
#' this is equal to the value of the \code{title} argument).
|
||||
#'
|
||||
#' @param inputId The \code{id} of the \code{tabsetPanel} (or
|
||||
#' \code{navlistPanel} or \code{navbarPage})into which \code{tab} will
|
||||
#' @param inputId The \code{id} of the \code{tabsetPanel} (or
|
||||
#' \code{navlistPanel} or \code{navbarPage})into which \code{tab} will
|
||||
#' be inserted/removed.
|
||||
#'
|
||||
#' @param tab The tab element to be added (must be created with
|
||||
@@ -38,7 +27,7 @@ getIcon <- function(tab) {
|
||||
#' @param target The \code{value} of an existing \code{tabPanel}, next to
|
||||
#' which \code{tab} will be added.
|
||||
#'
|
||||
#' @param position Should \code{tab} be added before or after the
|
||||
#' @param position Should \code{tab} be added before or after the
|
||||
#' \code{target} tab?
|
||||
#'
|
||||
#' @param session The shiny session within which to call \code{insertTab}.
|
||||
@@ -81,18 +70,27 @@ getIcon <- function(tab) {
|
||||
insertTab <- function(inputId, tab, target,
|
||||
position = c("before", "after"),
|
||||
session = getDefaultReactiveDomain()) {
|
||||
|
||||
|
||||
force(inputId)
|
||||
force(tab)
|
||||
force(target)
|
||||
position <- match.arg(position)
|
||||
force(session)
|
||||
|
||||
# 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
|
||||
# a tab was simply incrementing a counter. (Just like it was easy to
|
||||
# give a random 4-digit number to identify the tabsetPanel). Now that
|
||||
# we're introducing dynamic tabs, we have to retrive these numbers.
|
||||
|
||||
item <- buildTabItem("id", "tsid", TRUE, divTag = tab,
|
||||
textFilter = if (is.character(tab)) navbarMenuTextFilter else NULL)
|
||||
|
||||
callback <- function() {
|
||||
session$sendInsertTab(
|
||||
inputId = inputId,
|
||||
tab = processDeps(tab, session),
|
||||
icon = processDeps(getIcon(tab), session),
|
||||
liTag = processDeps(item$liTag, session),
|
||||
divTag = processDeps(item$divTag, session),
|
||||
target = target,
|
||||
prepend = FALSE,
|
||||
append = FALSE,
|
||||
@@ -103,17 +101,17 @@ insertTab <- function(inputId, tab, target,
|
||||
}
|
||||
|
||||
#' @param menuName This argument should only be used when you want to
|
||||
#' prepend (or append) \code{tab} to the beginning (or end) of an
|
||||
#' prepend (or append) \code{tab} to the beginning (or end) of an
|
||||
#' existing \code{\link{navbarMenu}} (which must itself be part of
|
||||
#' an existing \code{\link{navbarPage}}). In this case, this argument
|
||||
#' should be the \code{menuName} that you gave your \code{navbarMenu}
|
||||
#' when you first created it (by default, this is equal to the value
|
||||
#' an existing \code{\link{navbarPage}}). In this case, this argument
|
||||
#' should be the \code{menuName} that you gave your \code{navbarMenu}
|
||||
#' when you first created it (by default, this is equal to the value
|
||||
#' of the \code{title} argument). Note that you still need to set the
|
||||
#' \code{inputId} argument to whatever the \code{id} of the parent
|
||||
#' \code{navbarPage} is. If \code{menuName} is left as \code{NULL},
|
||||
#' \code{tab} will be prepended (or appended) to whatever
|
||||
#' \code{tab} will be prepended (or appended) to whatever
|
||||
#' \code{inputId} is.
|
||||
#'
|
||||
#'
|
||||
#' @rdname insertTab
|
||||
#' @export
|
||||
prependTab <- function(inputId, tab, menuName = NULL,
|
||||
@@ -123,17 +121,20 @@ prependTab <- function(inputId, tab, menuName = NULL,
|
||||
force(tab)
|
||||
force(menuName)
|
||||
force(session)
|
||||
|
||||
|
||||
item <- buildTabItem("id", "tsid", TRUE, divTag = tab,
|
||||
textFilter = if (is.character(tab)) navbarMenuTextFilter else NULL)
|
||||
|
||||
callback <- function() {
|
||||
session$sendInsertTab(
|
||||
inputId = inputId,
|
||||
tab = processDeps(tab, session),
|
||||
icon = processDeps(getIcon(tab), session),
|
||||
target = NULL,
|
||||
prepend = TRUE,
|
||||
append = FALSE,
|
||||
position = NULL)
|
||||
}
|
||||
session$sendInsertTab(
|
||||
inputId = inputId,
|
||||
liTag = processDeps(item$liTag, session),
|
||||
divTag = processDeps(item$divTag, session),
|
||||
target = NULL,
|
||||
prepend = TRUE,
|
||||
append = FALSE,
|
||||
position = NULL)
|
||||
}
|
||||
|
||||
session$onFlushed(callback, once = TRUE)
|
||||
}
|
||||
@@ -147,17 +148,20 @@ appendTab <- function(inputId, tab, menuName = NULL,
|
||||
force(tab)
|
||||
force(menuName)
|
||||
force(session)
|
||||
|
||||
|
||||
item <- buildTabItem("id", "tsid", TRUE, divTag = tab,
|
||||
textFilter = if (is.character(tab)) navbarMenuTextFilter else NULL)
|
||||
|
||||
callback <- function() {
|
||||
session$sendInsertTab(
|
||||
inputId = inputId,
|
||||
tab = processDeps(tab, session),
|
||||
icon = processDeps(getIcon(tab), session),
|
||||
target = NULL,
|
||||
prepend = FALSE,
|
||||
append = TRUE,
|
||||
position = NULL)
|
||||
}
|
||||
session$sendInsertTab(
|
||||
inputId = inputId,
|
||||
liTag = processDeps(item$liTag, session),
|
||||
divTag = processDeps(item$divTag, session),
|
||||
target = NULL,
|
||||
prepend = FALSE,
|
||||
append = TRUE,
|
||||
position = NULL)
|
||||
}
|
||||
|
||||
session$onFlushed(callback, once = TRUE)
|
||||
}
|
||||
@@ -184,25 +188,25 @@ removeTab <- function(inputId, target,
|
||||
#' Dynamically hide/show a tabPanel
|
||||
#'
|
||||
#' Dynamically hide or show a \code{\link{tabPanel}} from an existing
|
||||
#' \code{\link{tabsetPanel}}, \code{\link{navlistPanel}} or
|
||||
#' \code{\link{tabsetPanel}}, \code{\link{navlistPanel}} or
|
||||
#' \code{\link{navbarPage}}.
|
||||
#'
|
||||
#' For \code{navbarPage}, you can hide/show conventional
|
||||
#'
|
||||
#' For \code{navbarPage}, you can hide/show conventional
|
||||
#' \code{tabPanel}s (whether at the top level or nested inside a
|
||||
#' \code{navbarMenu}), as well as an entire \code{\link{navbarMenu}}.
|
||||
#' For the latter case, \code{target} should be the \code{menuName} that
|
||||
#' you gave your \code{navbarMenu} when you first created it (by default,
|
||||
#' \code{navbarMenu}), as well as an entire \code{\link{navbarMenu}}.
|
||||
#' For the latter case, \code{target} should be the \code{menuName} that
|
||||
#' you gave your \code{navbarMenu} when you first created it (by default,
|
||||
#' this is equal to the value of the \code{title} argument).
|
||||
#'
|
||||
#' @param inputId The \code{id} of the \code{tabsetPanel} (or
|
||||
#' \code{navlistPanel} or \code{navbarPage})into which \code{tab} will
|
||||
#' @param inputId The \code{id} of the \code{tabsetPanel} (or
|
||||
#' \code{navlistPanel} or \code{navbarPage})into which \code{tab} will
|
||||
#' be inserted/removed.
|
||||
#'
|
||||
#' @param target The \code{value} of the \code{tabPanel} to be
|
||||
#' hidden/shown. See Details if you want to hide/show an entire
|
||||
#' \code{navbarMenu} instead.
|
||||
#'
|
||||
#' @param session The shiny session within which to call this
|
||||
#'
|
||||
#' @param session The shiny session within which to call this
|
||||
#' function.
|
||||
#'
|
||||
#' @seealso \code{\link{insertTab}}
|
||||
@@ -233,9 +237,9 @@ removeTab <- function(inputId, target,
|
||||
#'
|
||||
#' shinyApp(ui, server)
|
||||
#' }
|
||||
#'
|
||||
#'
|
||||
#' # TODO: add example usage for `navbarMenu`
|
||||
#'
|
||||
#'
|
||||
#' @export
|
||||
showTab <- function(inputId, target,
|
||||
session = getDefaultReactiveDomain()) {
|
||||
|
||||
35
R/shiny.R
35
R/shiny.R
@@ -1492,27 +1492,22 @@ ShinySession <- R6Class(
|
||||
)
|
||||
)
|
||||
},
|
||||
sendInsertTab = function(inputId, tab, icon, target,
|
||||
prepend, append, position) {
|
||||
|
||||
if (is.null(target)) {
|
||||
if (prepend == append) {
|
||||
stop("If target is NULL, either `prepend` or `append` must be TRUE.",
|
||||
"Both cannot be TRUE, however.")
|
||||
}
|
||||
}
|
||||
|
||||
private$sendMessage(
|
||||
`shiny-insert-tab` = list(
|
||||
inputId = inputId,
|
||||
tab = tab,
|
||||
icon = icon,
|
||||
target = target,
|
||||
prepend = prepend,
|
||||
append = append,
|
||||
position = position
|
||||
)
|
||||
sendInsertTab = function(inputId, liTag, divTag, target, prepend, append, position) {
|
||||
if (is.null(target) && prepend == append) {
|
||||
stop("If target is NULL, either `prepend` or `append` must be TRUE.",
|
||||
"Both cannot be TRUE, however.")
|
||||
}
|
||||
private$sendMessage(
|
||||
`shiny-insert-tab` = list(
|
||||
inputId = inputId,
|
||||
liTag = liTag,
|
||||
divTag = divTag,
|
||||
target = target,
|
||||
prepend = prepend,
|
||||
append = append,
|
||||
position = position
|
||||
)
|
||||
)
|
||||
},
|
||||
sendRemoveTab = function(inputId, target) {
|
||||
private$sendMessage(
|
||||
|
||||
@@ -1338,39 +1338,20 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
|
||||
if ($tabsetPanel.length === 0) {
|
||||
throw 'There is no tabsetPanel with id ' + message.inputId;
|
||||
};
|
||||
|
||||
// This is the JS equivalent of the builtItem() R function that is used
|
||||
// to build a tabPanel when initializing a tabsetPanel
|
||||
var $tab = $(message.tab.html);
|
||||
var leadingHref = "#tab-" + $tabsetPanel.attr("data-tabsetid") + "-";
|
||||
|
||||
var prevTabIds = [];
|
||||
$tabsetPanel.find("> li").each(function () {
|
||||
var $prevTabs = $(this).find('> a[data-toggle="tab"]');
|
||||
if ($prevTabs.length > 0) prevTabIds.push($prevTabs.attr('href').replace(leadingHref, ''));
|
||||
});
|
||||
prevTabIds = prevTabIds.map(Number);
|
||||
var tabId = Math.max.apply(null, prevTabIds) + 1;
|
||||
|
||||
var tabsetNumericId = $tabsetPanel.attr("data-tabsetid");
|
||||
var thisId = "tab-" + tabsetNumericId + "-" + tabId;
|
||||
var icon = message.icon.html;
|
||||
|
||||
// if there is an icon, render the possible deps
|
||||
if (icon !== "") exports.renderDependencies(message.icon.deps);
|
||||
|
||||
var $aTag = $("<a>", {
|
||||
href: "#" + thisId,
|
||||
"data-toggle": "tab",
|
||||
"data-value": $tab.attr("data-value")
|
||||
}).append(icon).append($tab.attr("title"));
|
||||
|
||||
var $liTag = $("<li>").append($aTag);
|
||||
var $divTag = $tab.attr("id", thisId);
|
||||
$divTag.removeAttr("title");
|
||||
|
||||
var $tabContent = $("div.tab-content[data-tabsetid='" + tabsetNumericId + "']");
|
||||
|
||||
var $divTag = $(message.divTag.html);
|
||||
var $liTag = $(message.liTag.html);
|
||||
var $liChild = $liTag.find("> a");
|
||||
|
||||
if ($liChild.attr("data-toggle") === "tab") {
|
||||
// for regular tab, construct the correct tabId for both the li and the div tags
|
||||
var tabId = "tab-" + tabsetNumericId + "-" + getTabIndex();
|
||||
$liTag.find('> a[data-toggle="tab"]').attr("href", "#" + tabId);
|
||||
$divTag.attr("id", tabId);
|
||||
}
|
||||
|
||||
if (message.prepend || message.append) {
|
||||
if (message.prepend) {
|
||||
$tabsetPanel.prepend($liTag);
|
||||
@@ -1396,9 +1377,29 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
exports.renderDependencies(message.tab.deps);
|
||||
exports.renderContent($tabsetPanel[0], $tabsetPanel.html());
|
||||
exports.renderContent($tabContent[0], $tabContent.html());
|
||||
|
||||
/* 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
|
||||
a tab was simply incrementing a counter. (Just like it was easy to
|
||||
give a random 4-digit number to identify the tabsetPanel). Now that
|
||||
we're introducing dynamic tabs, we have to retrive these numbers and
|
||||
fix the dummy id given to the tab in the R side -- there, we always
|
||||
set the tab id (counter dummy) to "id" and the tabset id to "tsid") */
|
||||
function getTabIndex() {
|
||||
var prevTabIds = [];
|
||||
var leadingHref = "#tab-" + tabsetNumericId + "-";
|
||||
// loop through all existing tabs, find the one with highest id (since
|
||||
// this is based on a numeric counter) and add 1 to get the new tab's id
|
||||
$tabsetPanel.find("> li").each(function () {
|
||||
var $prevTabs = $(this).find('> a[data-toggle="tab"]');
|
||||
if ($prevTabs.length > 0) prevTabIds.push($prevTabs.attr('href').replace(leadingHref, ''));
|
||||
});
|
||||
prevTabIds = prevTabIds.map(Number); // convert strings to numbers
|
||||
return Math.max.apply(null, prevTabIds) + 1;
|
||||
}
|
||||
});
|
||||
|
||||
addMessageHandler('shiny-remove-tab', function (message) {
|
||||
|
||||
File diff suppressed because one or more lines are too long
6
inst/www/shared/shiny.min.js
vendored
6
inst/www/shared/shiny.min.js
vendored
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
@@ -719,40 +719,20 @@ var ShinyApp = function() {
|
||||
if ($tabsetPanel.length === 0) {
|
||||
throw 'There is no tabsetPanel with id ' + message.inputId;
|
||||
};
|
||||
|
||||
// This is the JS equivalent of the builtItem() R function that is used
|
||||
// to build a tabPanel when initializing a tabsetPanel
|
||||
var $tab = $(message.tab.html);
|
||||
var leadingHref = "#tab-" + $tabsetPanel.attr("data-tabsetid") + "-";
|
||||
|
||||
var prevTabIds = [];
|
||||
$tabsetPanel.find("> li").each(function(){
|
||||
var $prevTabs = $(this).find('> a[data-toggle="tab"]');
|
||||
if ($prevTabs.length > 0)
|
||||
prevTabIds.push($prevTabs.attr('href').replace(leadingHref,''));
|
||||
});
|
||||
prevTabIds = prevTabIds.map(Number);
|
||||
var tabId = Math.max.apply(null, prevTabIds) + 1;
|
||||
|
||||
var tabsetNumericId = $tabsetPanel.attr("data-tabsetid");
|
||||
var thisId = "tab-" + tabsetNumericId + "-" + tabId;
|
||||
var icon = message.icon.html;
|
||||
|
||||
// if there is an icon, render the possible deps
|
||||
if (icon !== "") exports.renderDependencies(message.icon.deps);
|
||||
|
||||
var $aTag = $("<a>", {
|
||||
href: "#" + thisId,
|
||||
"data-toggle": "tab",
|
||||
"data-value": $tab.attr("data-value")
|
||||
}).append(icon).append($tab.attr("title"));
|
||||
|
||||
var $liTag = $("<li>").append($aTag);
|
||||
var $divTag = $tab.attr("id", thisId);
|
||||
$divTag.removeAttr("title");
|
||||
|
||||
var $tabContent = $("div.tab-content[data-tabsetid='" + tabsetNumericId + "']");
|
||||
|
||||
var $divTag = $(message.divTag.html);
|
||||
var $liTag = $(message.liTag.html);
|
||||
var $liChild = $liTag.find("> a");
|
||||
|
||||
if ($liChild.attr("data-toggle") === "tab") {
|
||||
// for regular tab, construct the correct tabId for both the li and the div tags
|
||||
var tabId = "tab-" + tabsetNumericId + "-" + getTabIndex();
|
||||
$liTag.find('> a[data-toggle="tab"]').attr("href", "#" + tabId);
|
||||
$divTag.attr("id", tabId);
|
||||
}
|
||||
|
||||
if (message.prepend || message.append) {
|
||||
if (message.prepend) {
|
||||
$tabsetPanel.prepend($liTag);
|
||||
@@ -778,9 +758,30 @@ var ShinyApp = function() {
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
exports.renderDependencies(message.tab.deps);
|
||||
exports.renderContent($tabsetPanel[0], $tabsetPanel.html());
|
||||
exports.renderContent($tabContent[0], $tabContent.html());
|
||||
|
||||
/* 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
|
||||
a tab was simply incrementing a counter. (Just like it was easy to
|
||||
give a random 4-digit number to identify the tabsetPanel). Now that
|
||||
we're introducing dynamic tabs, we have to retrive these numbers and
|
||||
fix the dummy id given to the tab in the R side -- there, we always
|
||||
set the tab id (counter dummy) to "id" and the tabset id to "tsid") */
|
||||
function getTabIndex() {
|
||||
var prevTabIds = [];
|
||||
var leadingHref = "#tab-" + tabsetNumericId + "-";
|
||||
// loop through all existing tabs, find the one with highest id (since
|
||||
// this is based on a numeric counter) and add 1 to get the new tab's id
|
||||
$tabsetPanel.find("> li").each(function(){
|
||||
var $prevTabs = $(this).find('> a[data-toggle="tab"]');
|
||||
if ($prevTabs.length > 0)
|
||||
prevTabIds.push($prevTabs.attr('href').replace(leadingHref,''));
|
||||
});
|
||||
prevTabIds = prevTabIds.map(Number); // convert strings to numbers
|
||||
return(Math.max.apply(null, prevTabIds) + 1);
|
||||
}
|
||||
});
|
||||
|
||||
addMessageHandler('shiny-remove-tab', function(message) {
|
||||
|
||||
Reference in New Issue
Block a user