|
| 1 | + |
| 2 | +library(shiny) |
| 3 | +library(bslib) |
| 4 | + |
| 5 | +# If TRUE, the app starts with a sidebar present, which means that the sidebar |
| 6 | +# javascript is available on page load. Use this option for debugging the js. |
| 7 | +# In the first test, we don't include sidebars to test dynamic dep loading. |
| 8 | +INCLUDE_INITIAL_SIDEBAR <- Sys.getenv("INCLUDE_INITIAL_SIDEBAR", FALSE) |
| 9 | + |
| 10 | +color_pairs <- list( |
| 11 | + list(dark = "#1A2A6C", light = "#AED9E0"), |
| 12 | + list(dark = "#800020", light = "#F6DFD7"), |
| 13 | + list(dark = "#4B0082", light = "#E6E6FA"), |
| 14 | + list(dark = "#006D5B", light = "#A2D5C6") |
| 15 | +) |
| 16 | +adjectives <- c( |
| 17 | + "charming", "cuddly", "elegant", "fierce", "graceful", |
| 18 | + "majestic", "playful", "quirky", "silly", "witty" |
| 19 | +) |
| 20 | +animals <- c( |
| 21 | + "elephant", "giraffe", "jaguar", "koala", "lemur", |
| 22 | + "otter", "panda", "panther", "penguin", "zebra" |
| 23 | +) |
| 24 | + |
| 25 | +# Creates a nested sidebar layout with 2 left-aligned sidebars. Each sidebar has |
| 26 | +# one input and the main content area has one output that combines the inputs. |
| 27 | +nested_sidebar <- function(idx = 0L) { |
| 28 | + colors <- color_pairs[[idx %% length(color_pairs) + 1]] |
| 29 | + open <- c("desktop", "open", "closed")[idx %% 3 + 1] |
| 30 | + |
| 31 | + select_adjective <- function() { |
| 32 | + selectInput( |
| 33 | + paste0("adjective_", idx), |
| 34 | + "Adjective", |
| 35 | + choices = adjectives, |
| 36 | + selected = adjectives[idx %% length(adjectives) + 1] |
| 37 | + ) |
| 38 | + } |
| 39 | + |
| 40 | + select_animal <- function() { |
| 41 | + selectInput( |
| 42 | + paste0("animal_", idx), |
| 43 | + "Animal", |
| 44 | + choices = animals, |
| 45 | + selected = animals[idx %% length(animals) + 1] |
| 46 | + ) |
| 47 | + } |
| 48 | + |
| 49 | + layout_sidebar( |
| 50 | + id = paste0("main_outer_", idx), |
| 51 | + sidebar = sidebar( |
| 52 | + "Outer Sidebar", |
| 53 | + id = paste0("sidebar_outer_", idx), |
| 54 | + width = 150, |
| 55 | + bg = colors$dark, |
| 56 | + open = open, |
| 57 | + max_height_mobile = "300px", |
| 58 | + select_adjective() |
| 59 | + ), |
| 60 | + height = 300, |
| 61 | + class = "p-0", |
| 62 | + fillable = TRUE, |
| 63 | + layout_sidebar( |
| 64 | + id = paste0("main_inner_", idx), |
| 65 | + sidebar = sidebar( |
| 66 | + "Inner Sidebar", |
| 67 | + id = paste0("sidebar_inner_", idx), |
| 68 | + width = 150, |
| 69 | + bg = colors$light, |
| 70 | + open = open, |
| 71 | + select_animal() |
| 72 | + ), |
| 73 | + border = FALSE, |
| 74 | + border_radius = FALSE, |
| 75 | + h2("Sidebar Layout", idx), |
| 76 | + uiOutput(paste0("ui_content_", idx)), |
| 77 | + ) |
| 78 | + ) |> |
| 79 | + tagAppendAttributes(class = "mb-4", id = paste0("layout_", idx)) |
| 80 | +} |
| 81 | + |
| 82 | +ui <- page_fixed( |
| 83 | + h1("Dynamic Sidebars"), |
| 84 | + tags$head(tags$title("bslib | Tests | Dynamic Sidebars")), |
| 85 | + p( |
| 86 | + "Test dynamically added sidebars.", |
| 87 | + "Each new layout is a nested layout with two sidebars.", |
| 88 | + "The sidebar collapse toggles should not overlap when collapsed.", |
| 89 | + "Added sidebars rotate through open, closed, and desktop initial states.", |
| 90 | + "If you add a \"desktop\" sidebar while in mobile screen width", |
| 91 | + "(every 3rd addition), the sidebars will be closed when added." |
| 92 | + ), |
| 93 | + layout_column_wrap( |
| 94 | + width = 500, |
| 95 | + id = "sidebar-here", |
| 96 | + if (INCLUDE_INITIAL_SIDEBAR) nested_sidebar() |
| 97 | + ), |
| 98 | + div( |
| 99 | + class = "my-2", |
| 100 | + actionButton("add_sidebar", "Add sidebar layout"), |
| 101 | + actionButton("remove_sidebar", "Remove sidebar layout") |
| 102 | + ), |
| 103 | + div( |
| 104 | + class = "my-2", |
| 105 | + actionButton("show_all", "Show all"), |
| 106 | + actionButton("toggle_last_inner", "Toggle last inner"), |
| 107 | + actionButton("toggle_last_outer", "Toggle last outer") |
| 108 | + ) |
| 109 | +) |
| 110 | + |
| 111 | +server <- function(input, output, session) { |
| 112 | + idx <- 0L |
| 113 | + has_sidebar <- INCLUDE_INITIAL_SIDEBAR |
| 114 | + |
| 115 | + output_nested_sidebar <- function(idx) { |
| 116 | + output_id <- paste0("ui_content_", idx) |
| 117 | + adjective_id <- paste0("adjective_", idx) |
| 118 | + animal_id <- paste0("animal_", idx) |
| 119 | + |
| 120 | + output[[output_id]] <- renderUI({ |
| 121 | + p(sprintf("Hello, %s %s!", input[[adjective_id]], input[[animal_id]])) |
| 122 | + }) |
| 123 | + } |
| 124 | + |
| 125 | + if (INCLUDE_INITIAL_SIDEBAR) { |
| 126 | + observe({ |
| 127 | + isolate(output_nested_sidebar(0)) |
| 128 | + }) |
| 129 | + } |
| 130 | + |
| 131 | + observeEvent(input$add_sidebar, { |
| 132 | + if (idx == 0) has_sidebar <<- TRUE |
| 133 | + idx <<- idx + 1L |
| 134 | + |
| 135 | + insertUI( |
| 136 | + selector = "#sidebar-here", |
| 137 | + where = "beforeEnd", |
| 138 | + ui = nested_sidebar(idx) |
| 139 | + ) |
| 140 | + |
| 141 | + output_nested_sidebar(idx) |
| 142 | + }) |
| 143 | + |
| 144 | + observeEvent(input$remove_sidebar, { |
| 145 | + removeUI(selector = "#sidebar-here > :last-child") |
| 146 | + }) |
| 147 | + |
| 148 | + observeEvent(input$show_all, { |
| 149 | + req(has_sidebar) |
| 150 | + ids <- grep("^sidebar_", names(input), value = TRUE) |
| 151 | + for (id in ids) { |
| 152 | + message("opening ", id) |
| 153 | + sidebar_toggle(id, open = TRUE) |
| 154 | + } |
| 155 | + }) |
| 156 | + |
| 157 | + observeEvent(input$toggle_last_inner, { |
| 158 | + req(has_sidebar) |
| 159 | + sidebar_toggle(paste0("sidebar_inner_", idx)) |
| 160 | + }) |
| 161 | + |
| 162 | + observeEvent(input$toggle_last_outer, { |
| 163 | + req(has_sidebar) |
| 164 | + sidebar_toggle(paste0("sidebar_outer_", idx)) |
| 165 | + }) |
| 166 | +} |
| 167 | + |
| 168 | +shinyApp(ui, server) |
0 commit comments