|
| 1 | +#' Dynamically update nav containers |
| 2 | +#' |
| 3 | +#' Functions for dynamically updating nav containers (e.g., select, insert, and |
| 4 | +#' remove nav items). These functions require an `id` on the nav container to be |
| 5 | +#' specified. |
| 6 | +#' |
| 7 | +#' @param id a character string used to identify the nav container. |
| 8 | +#' @param selected a character string used to identify a particular [nav()] item. |
| 9 | +#' @param session a shiny session object (the default should almost always be used). |
| 10 | +#' @export |
| 11 | +#' @seealso [nav()], [navs_tab()]. |
| 12 | +#' @examples |
| 13 | +#' |
| 14 | +#' can_browse <- function() interactive() && require("shiny") |
| 15 | +#' |
| 16 | +#' # Selecting a tab |
| 17 | +#' if (can_browse()) { |
| 18 | +#' shinyApp( |
| 19 | +#' page_fluid( |
| 20 | +#' radioButtons("item", "Choose", c("A", "B")), |
| 21 | +#' navs_hidden( |
| 22 | +#' id = "container", |
| 23 | +#' nav_content("A", "a"), |
| 24 | +#' nav_content("B", "b") |
| 25 | +#' ) |
| 26 | +#' ), |
| 27 | +#' function(input, output) { |
| 28 | +#' observe(nav_select("container", input$item)) |
| 29 | +#' } |
| 30 | +#' ) |
| 31 | +#' } |
| 32 | +#' |
| 33 | +#' # Inserting and removing |
| 34 | +#' if (can_browse()) { |
| 35 | +#' ui <- page_fluid( |
| 36 | +#' actionButton("add", "Add 'Dynamic' tab"), |
| 37 | +#' actionButton("remove", "Remove 'Foo' tab"), |
| 38 | +#' navs_tab( |
| 39 | +#' id = "tabs", |
| 40 | +#' nav("Hello", "hello"), |
| 41 | +#' nav("Foo", "foo"), |
| 42 | +#' nav("Bar", "bar tab") |
| 43 | +#' ) |
| 44 | +#' ) |
| 45 | +#' server <- function(input, output) { |
| 46 | +#' observeEvent(input$add, { |
| 47 | +#' nav_insert( |
| 48 | +#' "tabs", target = "Bar", select = TRUE, |
| 49 | +#' nav("Dynamic", "Dynamically added content") |
| 50 | +#' ) |
| 51 | +#' }) |
| 52 | +#' observeEvent(input$remove, { |
| 53 | +#' nav_remove("tabs", target = "Foo") |
| 54 | +#' }) |
| 55 | +#' } |
| 56 | +#' shinyApp(ui, server) |
| 57 | +#' } |
| 58 | +#' |
| 59 | +nav_select <- function(id, selected = NULL, |
| 60 | + session = getDefaultReactiveDomain()) { |
| 61 | + shiny::updateTabsetPanel(session, id, selected) |
| 62 | +} |
| 63 | + |
| 64 | + |
| 65 | +#' @param nav a [nav()] item. |
| 66 | +#' @param target The `value` of an existing `nav()` item, next to which tab will be added. If removing: the `value` of the `nav()` item that you want to remove. |
| 67 | +#' @param position Should `nav` be added before or after the target? |
| 68 | +#' @param select Should `nav` be selected upon being inserted? |
| 69 | +#' @rdname nav_select |
| 70 | +#' @export |
| 71 | +nav_insert <- function(id, nav, target = NULL, position = c("after", "before"), |
| 72 | + select = FALSE, session = getDefaultReactiveDomain()) { |
| 73 | + |
| 74 | + force(target) |
| 75 | + force(select) |
| 76 | + position <- match.arg(position) |
| 77 | + inputId <- session$ns(id) |
| 78 | + |
| 79 | + # Barbara -- August 2017 |
| 80 | + # Note: until now, the number of tabs in a tabsetPanel (or navbarPage |
| 81 | + # or navlistPanel) was always fixed. So, an easy way to give an id to |
| 82 | + # a tab was simply incrementing a counter. (Just like it was easy to |
| 83 | + # give a random 4-digit number to identify the tabsetPanel). Since we |
| 84 | + # can only know this in the client side, we'll just pass `id` and |
| 85 | + # `tsid` (TabSetID) as dummy values that will be fixed in the JS code. |
| 86 | + item <- buildTabItem("id", "tsid", TRUE, divTag = nav, |
| 87 | + textFilter = if (is.character(nav)) navbarMenuTextFilter else NULL) |
| 88 | + |
| 89 | + callback <- function() { |
| 90 | + session$sendInsertTab( |
| 91 | + inputId = inputId, |
| 92 | + liTag = processDeps(item$liTag, session), |
| 93 | + divTag = processDeps(item$divTag, session), |
| 94 | + menuName = NULL, |
| 95 | + target = target, |
| 96 | + position = position, |
| 97 | + select = select) |
| 98 | + } |
| 99 | + session$onFlush(callback, once = TRUE) |
| 100 | +} |
| 101 | + |
| 102 | +#' @export |
| 103 | +#' @rdname nav_select |
| 104 | +nav_remove <- function(id, target, session = getDefaultReactiveDomain()) { |
| 105 | + force(target) |
| 106 | + inputId <- session$ns(id) |
| 107 | + |
| 108 | + callback <- function() { |
| 109 | + session$sendRemoveTab( |
| 110 | + inputId = inputId, |
| 111 | + target = target |
| 112 | + ) |
| 113 | + } |
| 114 | + session$onFlush(callback, once = TRUE) |
| 115 | +} |
| 116 | + |
| 117 | +#' @export |
| 118 | +#' @rdname nav_select |
| 119 | +nav_show <- function(id, target, select = FALSE, |
| 120 | + session = getDefaultReactiveDomain()) { |
| 121 | + shiny::showTab(id, target, select, session) |
| 122 | +} |
| 123 | + |
| 124 | +#' @export |
| 125 | +#' @rdname nav_select |
| 126 | +nav_hide <- function(id, target, |
| 127 | + session = getDefaultReactiveDomain()) { |
| 128 | + shiny::hideTab(id, target, session) |
| 129 | +} |
0 commit comments