Search code examples
rshinyshinydashboard

shinydashboardPlus/dashboardUser. Collapse User box


I adapted the code from here. This is my code:

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)

shinyApp(
  ui = dashboardPage(
    header = dashboardHeader(userOutput("user")),
    sidebar = dashboardSidebar(),
    body = dashboardBody(uiOutput("body")),
    title = "DashboardPage"
  ),
  server = function(input, output) {
    output$user <- renderUser({
      dashboardUser(
        name = "Divad Nojnarg", 
        image = "https://adminlte.io/themes/AdminLTE/dist/img/user2-160x160.jpg", 
        title = "shinydashboardPlus",
        subtitle = "Author", 
        footer = p("The footer", class = "text-center"),
        fluidRow(
          actionButton("btn1","Click")
        )
      )
    })
    
    observeEvent(input$btn1, {  #Not triggering
      output$body <- renderUI({print("Clicked")})
    })      
  }
)

What I want is the user box (what is in red) not to remain active (I mean, to make it to disappear) when I click on the button.

enter image description here

Any suggestion?


Solution

  • One workaround to do this is to use shinyjs::hide() and shinyjs::show(). Targeting the action button inside the user is easy. The tricky part is to get the dashboard user to show up again when the dropdown menu is clicked. For this we can rewrite the dashboardUser() function and add an action link with id instead of the "normal" link. See comments in code:

    library(shiny)
    library(shinyWidgets)
    library(shinydashboard)
    library(shinydashboardPlus)
    library(shinyjs)
    
    dashboardUser
    
    myDashboardUser <- function (..., name = NULL, image = NULL, title = NULL, subtitle = NULL, 
                                 footer = NULL) 
    {
      if (!is.null(title)) {
        line_1 <- paste0(name, " - ", title)
      }
      else {
        line_1 <- name
      }
      if (!is.null(subtitle)) {
        user_text <- shiny::tags$p(line_1, shiny::tags$small(subtitle))
        user_header_height <- NULL
      }
      else {
        user_text <- shiny::tags$p(line_1)
        user_header_height <- shiny::tags$script(
          shiny::HTML("$(\".user-header\").css(\"height\", \"145px\")")
        )
      }
      userTag <- shiny::tagList(
        shiny::tags$head(
          shiny::tags$script("$(function() {\n
                               $('.dashboard-user').on('click', function(e){\n
                               e.stopPropagation();\n
                               });\n
                               });\n
                               ")),
        # we need to add an id and the class `action-button` to this link
        shiny::tags$a(id = "user_dropdown",
                      href = "#",
                      class = "dropdown-toggle action-button",
                      `data-toggle` = "dropdown",
                      shiny::tags$img(src = image,
                                      class = "user-image",
                                      alt = "User Image"),
                      shiny::tags$span(class = "hidden-xs",
                                       name)
        ),
        shiny::tags$ul(class = "dropdown-menu dashboard-user", 
                       shiny::tags$li(class = "user-header",
                                      if (!is.null(user_header_height)) user_header_height,
                                      shiny::tags$img(src = image, 
                                                      class = "img-circle",
                                                      alt = "User Image"),
                                      user_text), 
                       if (length(list(...)) > 0) 
                         shiny::tags$li(class = "user-body", ...),
                       if (!is.null(footer)) 
                         shiny::tags$li(class = "user-footer", footer)
        )
      )
      userTag
    }
    }
    
    shinyApp(
      ui = dashboardPage(
        header = dashboardHeader(userOutput("user")),
        sidebar = dashboardSidebar(),
        body = dashboardBody(
          # make ShinyJs available
          useShinyjs(),
          uiOutput("body")
        ),
        title = "DashboardPage"
      ),
      server = function(input, output) {
        
        output$user <- renderUser({
          myDashboardUser(
            name = "Divad Nojnarg", 
            image = "https://adminlte.io/themes/AdminLTE/dist/img/user2-160x160.jpg", 
            title = "shinydashboardPlus",
            subtitle = "Author", 
            footer = p("The footer", class = "text-center"),
            fluidRow(
              actionButton("btn1","Click")
            )
          )
        })
        
        # use shinyjs::hide on button and also remove class open from user menue
        observeEvent(input$btn1, { 
          hide(selector = ".dropdown-menu.dashboard-user")
          removeClass(id = "user", class = "open")
        })      
        
        # use shinyjs::show on new link
        observeEvent(input$user_dropdown, { 
          show(selector = ".dropdown-menu.dashboard-user")
        })      
      }
    )