shinydashboardPlus/dashboardUser. Collapse User box - r

Question

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.
Any suggestion?

Answer 1

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")
})
}
)

Answer 2

As I realized that by clicking anywhere, the user box disappear, I have just used a piece of javascript code to simulate clicking over "body" element:
jscode<-
'var evt = document.createEvent("MouseEvents");
evt.initMouseEvent("click", true, true, window,
0, 0, 0, 0, 0, false, false, false, false, 0, null);
var cb = document.getElementById("body");
var simulateClick = cb.dispatchEvent(evt);'
My final version:
library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(userOutput("user")),
sidebar = dashboardSidebar(),
body = dashboardBody(useShinyjs(), 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")})
jscode<-
'var evt = document.createEvent("MouseEvents");
evt.initMouseEvent("click", true, true, window,
0, 0, 0, 0, 0, false, false, false, false, 0, null);
var cb = document.getElementById("body");
var simulateClick = cb.dispatchEvent(evt)';
runjs(jscode)
})
}
)