Skip to content
Advertisement

Shiny: Using enter key with action button on login screen

I created a login screen for my Shiny app and would like users to be able to use the Enter key instead of having to use the mouse to click the OK button. I found an example that looks like it solves it for an input form but unfortunately, it does not work for my example. I am imagining it has something to do with the modal dialog. (have seen a lot of duplicate questions for this topic, this is a new parameter and none of those solutions have solved it)

SO Reference: Using enter key with action button in R Shiny

Example Code:

library(shiny)
library(shinydashboard)

Logged = FALSE
my_username <- "test"
my_password <- "test"

js <- 

ui <- dashboardPage(skin='blue',
                    dashboardHeader( title = "Dashboard"),
                    dashboardSidebar(),
                    dashboardBody("Test",
                                  tags$script('
                                      $(document).keyup(function(event) {
                                      if ($("#password").is(":focus") && (event.keyCode == 13)) {
                                      $("#ok").click();
                                      }
                                      });
                                      '),
                                  verbatimTextOutput("dataInfo")
                    )
)

server = function(input, output,session) {

  values <- reactiveValues(authenticated = FALSE)

  # Return the UI for a modal dialog with data selection input. If 'failed' 
  # is TRUE, then display a message that the previous value was invalid.
  dataModal <- function(failed = FALSE) {
    modalDialog(
      textInput("username", "Username:"),
      passwordInput("password", "Password:"),
      footer = tagList(
        # modalButton("Cancel"),
        actionButton("ok", "OK")
      )
    )
  }

  # Show modal when button is clicked.  
  # This `observe` is suspended only whith right user credential

  obs1 <- observe({
    showModal(dataModal())
  })

  # When OK button is pressed, attempt to authenticate. If successful,
  # remove the modal. 

  obs2 <- observe({
    req(input$ok)
    isolate({
      Username <- input$username
      Password <- input$password
    })
    Id.username <- which(my_username == Username)
    Id.password <- which(my_password == Password)
    if (length(Id.username) > 0 & length(Id.password) > 0) {
      if (Id.username == Id.password) {
        Logged <<- TRUE
        values$authenticated <- TRUE
        obs1$suspend()
        removeModal()

      } else {
        values$authenticated <- FALSE
      }     
    }
  })


  output$dataInfo <- renderPrint({
    if (values$authenticated) "OK!!!!!"
    else "You are NOT authenticated"
  })

}

shinyApp(ui,server)

Advertisement

Answer

For anyone else who stumbles upon this thread, this solution (unlike the accepted solution to the above-linked SO post Using enter key with action button in R Shiny) does not require an external js script file.

The js script should have been included inside the modalDialog() instead, and inside the HTML() function, as follows:

library(shiny)
library(shinydashboard)

Logged = FALSE
my_username <- "test"
my_password <- "test"

js <- '
$(document).keyup(function(event) {
  if ($("#password").is(":focus") && (event.keyCode == 13)) {
      $("#ok").click();
  }
});
'

ui <- dashboardPage(skin = "blue",
                    dashboardHeader(title = "Dashboard"),
                    dashboardSidebar(),
                    dashboardBody("Test",
                                  verbatimTextOutput("dataInfo")
                    )
)

server = function(input, output, session) {

  values <- reactiveValues(authenticated = FALSE)

  # Return the UI for a modal dialog with data selection input. If 'failed' 
  # is TRUE, then display a message that the previous value was invalid.
  dataModal <- function(failed = FALSE) {
    modalDialog(
      tags$script(HTML(js)),
      textInput("username", "Username:"),
      passwordInput("password", "Password:"),
      footer = tagList(
        # modalButton("Cancel"),
        actionButton("ok", "OK")
      )
    )
  }

  # Show modal when button is clicked.  
  # This `observe` is suspended only whith right user credential

  obs1 <- observe({
    showModal(dataModal())
  })

  # When OK button is pressed, attempt to authenticate. If successful,
  # remove the modal. 

  obs2 <- observe({
    req(input$ok)
    isolate({
      Username <- input$username
      Password <- input$password
    })
    Id_username <- which(my_username == Username)
    Id_password <- which(my_password == Password)
    if (length(Id_username) > 0 & length(Id_password) > 0) {
      if (Id_username == Id_password) {
        Logged <<- TRUE
        values$authenticated <- TRUE
        obs1$suspend()
        removeModal()

      } else {
        values$authenticated <- FALSE
      }     
    }
  })


  output$dataInfo <- renderPrint({
    if(values$authenticated){
      "OK!!!!!"
    } else {
      "You are NOT authenticated"
    }
  })

}

shinyApp(ui,server)

Also, as a side note, I believe that the js script was originally inspired by this example.

Advertisement