How can I tell within a Shiny app if the navbar is collapsed?

Viewed 134

I have a Shiny app that uses a navbarPage() structure with a fixed position, collapsible navbar. I want to be able to check within my server-side code whether the navbar is currently collapsed or not. I am using Bootstrap 4.

Here is some example code that illustrates the app set up, with some pseudo-code on the server side:

library(shiny)
library(bslib)

ui <- navbarPage(
  title = "An app",
  # Specifying Bootstrap 4, as solutions may differ
  # by Bootstrap version
  theme = bs_theme(version = "4"),
  tabPanel(title = "A tab",
           position = "fixed-top",
           collapsible = TRUE,
           "Some content")
  
)

server <- function(input, output, session) {
  # PSEUDO-CODE:
  # if (navbar_is_collapsed) {
  #   do something
  # }
  
}

shinyApp(ui, server)

Created on 2021-06-15 by the reprex package (v2.0.0)

How can I check within server whether the navbar is collapsed or not?

1 Answers

First of all, arguments position and collapsible are part of navbarPage and not tabPanel.

If you read the documentation of ?navbarPage it gives a first hint, when the menu is collapsed:

collapsible: ‘TRUE’ to automatically collapse the navigation elements
          into a menu when the width of the browser is less than 940
          pixels (useful for viewing on smaller touchscreen device)

Looking further into bootstrap.css we see that @media rules are defined, to define breakpoints, when the HTML should render differently. This gives us the hook which we are looking for:

  1. Use Javascript to get the actual breakpoints (it turns out that despite the documentation the menu gets collapsed at widths of below 576px on my system).
  2. Inform shiny whenever the screen gets resized via the resize event. For convenience, we report which breakpoint we are currently falling below). The critical breakpoint is the smallest (i.e. breakpoint at position 0).
  3. We can then listen to this newly created input and react accordingly.
library(shiny)
library(bslib)
js <- HTML("
(function() {
   function getAllMediaBreakpoints() {
      var bt_css = $.grep(document.styleSheets, (css) => /bootstrap/.test(css.href))[0];
      var media_rules = $.grep(bt_css.cssRules, (rule) => rule instanceof CSSMediaRule & 
                                                          /min-width/.test(rule.conditionText));
      var widths = $.map(media_rules, (rule) => parseInt(rule.conditionText.replace(/.*:\\s?(\\d+)px.*/, '$1')));
      return $.grep(widths, (width, index) => index == $.inArray(width, widths));
   }
   function getBreakpoint(all_breakpoints) {
      var width = (window.innerWidth > 0) ? window.innerWidth : screen.width;
      for (var i = 0; i < all_breakpoints.length; i++) {
         var lim = all_breakpoints[i];
         if (width < lim) {
            return(i)
         }
      }
      return(i);
   }
   const breakpoints = getAllMediaBreakpoints();
   $(document).one('shiny:connected', () => Shiny.setInputValue('breakpoint', getBreakpoint(breakpoints)));
   $(window).on('resize', () => Shiny.setInputValue('breakpoint', getBreakpoint(breakpoints)))
})();")

ui <- navbarPage(
  title = "An app",
  theme = bs_theme(version = "4"),
  # position = "fixed-top", # removed to not hide the content below the navbar
  selected = "A tab", # this argument bwlongs to navbarPage and not tabPanel
  collapsible = TRUE, # this argument bwlongs to navbarPage and not tabPanel
  tags$head(tags$script(js)), # include our JavaScript
  tabPanel(title = "A tab",
           h3("Title"),
           verbatimTextOutput("collapsed")))

server <- function(input, output, session) {
  navbar_is_collapsed <- reactive(input$breakpoint == 0)
  output$collapsed <- renderPrint(paste("Collapsed:", navbar_is_collapsed()))
  
}

shinyApp(ui, server)

You can test that by running the app and resizing the window, you will see that the mment the menu get collpased, the text box is updated accordingly.

Related