javascript - Shiny :在登录屏幕上使用带有操作按钮的回车键

Question

我为我的 Shiny 应用程序创建了一个登录屏幕，并希望用户能够使用 Enter 键，而不必使用鼠标单击 OK 按钮。我找到了一个看起来可以解决输入表单问题的示例，但不幸的是，它不适用于我的示例。我想它与模态对话框有关。 (看到很多关于这个主题的重复问题，这是一个新参数，这些解决方案都没有解决它)

SO 引用: Using enter key with action button in R Shiny

示例代码:

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)

Answer 1

对于偶然发现此线程的任何其他人，此解决方案(与上面链接的 SO 帖子 在 R Shiny 中使用带有操作按钮的回车键 的 accepted solution 不同)不需要外部 js脚本文件。

js 脚本应该包含在 modalDialog() 中，而不是在 HTML() 函数中，如下所示:

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)

此外，作为旁注，我相信 js 脚本最初的灵感来自 this example .