在点击闪亮的动作按钮后，将光标聚焦在textArea中

Question

我不是HTML或JavaScript的专家。所以，我希望你能帮助解决这个问题。

我想我应该提供我的应用程序的较小版本，以便能够解释问题。这里是一个简单的应用程序的app.R，允许用户在textArea中编写一个单词。该单词的第一个字母将自动显示为动作按钮的标签，如果用户单击动作按钮，textArea的内容将更新，说明用户编写的单词是以元音还是辅音开头。

library(shiny) 
library(shinydashboard) 

# Define UI for application 
ui <- dashboardPage(
    dashboardHeader(
      title = "page_title" 
    ), 
    dashboardSidebar(
    ), 
    dashboardBody(
      tabBox(title = "app_title", 
        id = "id", width = "800px", 
        tabPanel("tab1)", 
          fluidRow(
            column(width = 12, 
              box(
                status = "info", solidHeader = TRUE, 
                collapsible = FALSE, 
                width = 12, 
                title = "textInput", 
                tags$textarea(id = "text_input1", rows = 2, cols = 50, "", autofocus = "autofocus"), 
                fluidRow(
                  column(width = 12, 
                  actionButton("actionbutton1", label = textOutput("actionbutton1_label")) 
                  )))))), 
        tabPanel("tab2" 
        )))) 

# Define server logic 

server <- function(input, output, session) { 
    data1 <- eventReactive(input$actionbutton1, {substr(input$text_input1, 1, 1)}) 
    output$actionbutton1_label <- renderPrint(cat(noquote({substr(input$text_input1, 1, 1)}))) 
    observe({ 
      if (input$actionbutton1 == 0) return() 
      isolate({ 
        if (data1() %in% c("a", "e", "i", "o", "u")) { 
          updateTextInput(session, "text_input1", 
              value = paste(input$text_input1, "starts with a vowel", "", sep = " ")) 
        } 
        else { 
          updateTextInput(session, "text_input1", 
              value = paste(input$text_input1, "starts with a consonant", "", sep = " ")) 
        } 
      }) 
    })} 
# Run the application 
shinyApp(ui = ui, server = server) 

问题定义： 当您运行首次上面的应用程序，你会看到光标在textarea的，因为参数自动对焦=“自动对焦”中的textarea标签的定义，所以没问题重点在于加载。当您点击操作按钮时，光标不再位于textArea中。在这个简单的应用程序中，这看起来没有必要，但在实际应用程序中，这很重要，我希望在用户单击操作按钮后将光标放回到textArea中。

问题再次出现在应用程序的用户点击操作按钮时，光标从textArea中消失，应用程序的用户必须单击文本区域才能返回光标并继续使用他/她的投入。无论用户使用应用界面的其他元素多少次，我都希望通过保持光标始终处于活动状态并集中在textArea中来保存用户的额外点击。

研究：网上有很多关于如何控制光标位置的帖子。在这些文章中，我认为，并请纠正我，如果我错了，这种做法几乎是最相关的一个希望实现的目标：

http://www.mediacollege.com/internet/javascript/form/focus.html

这是什么特别我需要帮助：

如果你点击上面的链接，你会发现一个很有趣的HTML代码块，我复制到这里：

<form name="myform2"> 
<input type="text" name="mytextfield2"> 
<input type="button" name="mybutton" value="Set Focus" OnClick="document.myform2.mytextfield2.focus();"> 
</form> 

这是我希望你能够帮助我，我如何以及在哪里可以嵌入这个代码在我的闪亮ui.R？当然，我将不得不为TextArea和按钮分配一个表单，并相应地更改textArea和按钮的名称。我只需要几乎使上面的HTML代码ui.R友好（可读和可执行）。任何帮助都非常感谢。

我试过到目前为止，并没有奏效：

tags$head(HTML("<form name="myform2"> 
         <input type="text" name="text_input1"> 
         <input type="button" name="addword1" value="Set Focus" OnClick="document.myform2.text_input1.focus();"> 
         </form>")) 

正如你所看到的，语法搞砸和语法警告的种种提出了，当我嵌入上面的代码在ui.R文件中。

可能很重要：我使用闪亮的仪表板，并且textArea ad操作按钮在dashboardBody的tabBox中的tabPanel中定义。

非常感谢

Answer 1

这里是像你这样的工作版本问：

library(shiny) 
library(shinydashboard) 

# Define UI for application 
ui <- dashboardPage(
    dashboardHeader(
    title = "page_title" 
), 
    dashboardSidebar(
), 
    dashboardBody(tags$head(tags$script(
    'Shiny.addCustomMessageHandler("refocus", 
            function(NULL) { 
            document.getElementById("text_input1").focus(); 
            });' 
    )), 
    tabBox(title = "app_title", 
      id = "id", width = "800px", 
      tabPanel("tab1", 
        fluidRow(
         column(width = 12, 
          box(
           status = "info", solidHeader = TRUE, 
           collapsible = FALSE, 
           width = 12, 
           title = "textInput", 
           tags$textarea(id = "text_input1", rows = 2, cols = 50, "", autofocus = "autofocus"), 
           fluidRow(
           column(width = 12, 
             actionButton("actionbutton1", label = textOutput("actionbutton1_label")) 
           )))))), 
      tabPanel("tab2" 
      )))) 

# Define server logic 

server <- function(input, output, session) { 
    data1 <- eventReactive(input$actionbutton1, { 

    substr(input$text_input1, 1, 1) 

    }) 

    output$actionbutton1_label <- renderPrint(cat(noquote({substr(input$text_input1, 1, 1)}))) 

    observeEvent(input$actionbutton1,{ 

    isolate({ 
     if (data1() %in% c("a", "e", "i", "o", "u")) { 
     updateTextInput(session, "text_input1", 
         value = paste(input$text_input1, "starts with a vowel", "", sep = " ")) 
     } 
     else { 
     updateTextInput(session, "text_input1", 
         value = paste(input$text_input1, "starts with a consonant", "", sep = " ")) 
     } 

     session$sendCustomMessage(type="refocus",message=list(NULL)) 

    }) 

    })} 
# Run the application 
shinyApp(ui = ui, server = server) 

Answer 2

所以在UI方面，你需要这样的事：

tags$script(' 
Shiny.addCustomMessageHandler("myCallbackHandler", 
     function(null) { 
      document.myform2.text_input1.focus(); 
     }); 
') 

然后在相关actionButton调用此函数的observeEvent：

session$sendCustomMessage("myCallbackHandler",list(NULL)) 

因此，无论何时在服务器中调用该自定义处理程序时，它都将关注到输入。您可能需要更改函数中的JavaScript以使页面能够正常工作，因为我不知道HTML中对象的名称。

希望这会有所帮助。