Search code examples
rshinyshinydashboardsweetalert

shinydashboard's dropdownMenu event on click


Following this question and answer Get the most recently clicked notificationItem of a dropdownmenu in shinydashboard

I created the app below which nicely opens a sweetalert when clicking on a taskItem.

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(tidyverse)
ui <- fluidPage(
    dashboardPage(
        dashboardHeader(dropdownMenuOutput("dropdownmenu")),
        dashboardSidebar(),
        dashboardBody(
            tags$script(HTML("function clickFunction(link){ Shiny.onInputChange('linkClicked',link);}")),

    )))

server = shinyServer(function(input, output, session){
    output$dropdownmenu = renderMenu({

        aa <- 1:2 %>% 
           map(~taskItem(text = paste("This is no", .), value = ., color = c("red", "blue")[.]))

        for(i in 1:length(aa)){
            aa[[i]]$children[[1]] <- a(href="#","onclick"=paste0("clickFunction('",paste("This is no", i),"'); return false;"),
                                              aa[[i]]$children[[1]]$children)
        }
        dropdownMenu(type = "tasks", badgeStatus = "warning",
                     .list = aa)
    })


   observeEvent(input$linkClicked, {
        sendSweetAlert(
            session = session,
            text = input$linkClicked,
            type = "info",
            showCloseButton = TRUE)
    })
})

shinyApp(ui = ui, server = server)

But hitting the same taskItem twice will not open the sweetalert again. It will only be opened again when hitting another item in between. How to fix that?


Solution

  • You can find a good article about that on the rstudio website: https://shiny.rstudio.com/articles/js-send-message.html.

    Root of the problem:

    Caveat: Shiny only listens for changes in the value of a message. Hence, if you call doAwesomeThing2 twice with the same arguments, the second call will not trigger the observeEvent block because the object you send is unchanged.

    Solution:

    This can be overcome by adding a random value to your object, which makes the object as a whole appear changed to Shiny. In R, you simply ignore that part of the object....

    So in your case you can change the code to:

    tags$script(HTML("function clickFunction(link){
                          var rndm = Math.random();
                           Shiny.onInputChange('linkClicked', {data:link, nonce: Math.random()});}"
          ))
    

    The call to the triggered input will be:

    input$linkClicked$data
    

    Full reproducible example:

    library(shiny)
    library(shinydashboard)
    library(tidyverse)
    library(shinyWidgets)
    
    ui <- fluidPage(
      dashboardPage(
        dashboardHeader(dropdownMenuOutput("dropdownmenu")),
        dashboardSidebar(),
        dashboardBody(
          tags$script(HTML("function clickFunction(link){
                          var rndm = Math.random();
                           Shiny.onInputChange('linkClicked', {data:link, nonce: Math.random()});}"
          )),
    
        )))
    
    server = shinyServer(function(input, output, session){
      output$dropdownmenu = renderMenu({
    
        aa <- 1:2 %>% 
          map(~taskItem(text = paste("This is no", .), value = ., color = c("red", "blue")[.]))
    
        for(i in 1:length(aa)){
          aa[[i]]$children[[1]] <- a(href="#","onclick"=paste0("clickFunction('",paste("This is no", i),"'); return false;"),
                                     aa[[i]]$children[[1]]$children)
        }
        dropdownMenu(type = "tasks", badgeStatus = "warning",
                     .list = aa)
      })
    
    
      observeEvent(input$linkClicked, {
        sendSweetAlert(
          session = session,
          text = input$linkClicked$data,
          type = "info"
        )
      })
    })
    
    shinyApp(ui = ui, server = server)
    

    Note:

    I assume you have the sweetalert() function from shinyWidgets, but i didnt have the possibility to add the showCloseButton parameter, so i removed it.