首页 > 解决方案 > 闪亮:在登录屏幕上使用带有操作按钮的回车键

问题描述

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

SO参考: 在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)

标签: javascriptrshinyshinyjs

解决方案


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

js脚本应该包含在insteadmodalDialog()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 脚本最初是受此示例启发的。


推荐阅读