rshinybslib

How to dynamically change the width of a bslib sidebar using an input?

I'm trying to implement a dynamic user controlled sidebar width into an app that uses a bslib page_navbar layout with multiple nav_panels. Each nav_panel has a layout_sidebar. I want the user to control the sidebar width with a sliderInput but for now, nothing happens, when we change the slider values. I suspect that the JS code snippet (ai generated) might not be suited for that task but I lack deep knowledge on JS unfortunately. Here is my reprex with only one nav_panel.

library(shiny)
library(bslib)

js_code <- "
Shiny.addCustomMessageHandler('sidebarWidth', function(width) {
  document.documentElement.style.setProperty('--sidebar-width', width + 'px');
});
"

ui <- page_navbar(
  title = "Sidebar",
  
  nav_panel(
    "Tab 1",
    layout_sidebar(
      sidebar = sidebar(
        sliderInput("sidebarWidth", "Sidebar width", min = 230, max = 500, value = 230)
        ),
        fill = TRUE,
        div("Main content inside sidebar layout.")
      )
    ),  
  tags$script(HTML(js_code))
)

server <- function(input, output, session) {
  
  observeEvent(input$sidebarWidth, {
    session$sendCustomMessage("sidebarWidth", input$sidebarWidth)
  })
  
}

shinyApp(ui, server)

Any ideas? Different approaches? I found this solution, but I couldn't make it work with bslib.

Solution

  • bslib::layout_sidebar defines a div which has style = css(`--_sidebar-width` = sidebar$width, ..., hence, you can use

    Shiny.addCustomMessageHandler('sidebarWidth', function(width) {
  document.querySelector('.bslib-sidebar-layout').style.setProperty('--_sidebar-width', width + 'px');
});

    enter image description here

    library(shiny)
library(bslib)

js_code <- "
Shiny.addCustomMessageHandler('sidebarWidth', function(width) {
  document.querySelector('.bslib-sidebar-layout').style.setProperty('--_sidebar-width', width + 'px');
});
"

ui <- page_navbar(
  title = "Sidebar",
  nav_panel(
    "Tab 1",
    tags$script(HTML(js_code)),
    layout_sidebar(
      sidebar = sidebar(
        sliderInput("sidebarWidth", "Sidebar width", min = 230, max = 500, value = 230)
      ),
      fill = TRUE,
      div("Main content inside sidebar layout.")
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$sidebarWidth, {
    session$sendCustomMessage("sidebarWidth", input$sidebarWidth)
  })
}

shinyApp(ui, server)