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.