在Shiny R中的TextAreaInput中找到插入位置

时间:2017-10-02 14:49:59

标签: javascript r shiny shinyjs

我正在努力解决这个问题。我在Shiny中有一个textAreaInput字段,我希望用户能够将光标定位在该字段中的文本中,单击一个按钮,然后在该位置粘贴其他文本。我正在努力弄清楚如何在点击按钮时找到该文本字段中的插入位置。我认为这可能需要一个java解决方案 - 但我没有运气让这个工作。非常感谢任何提示。

这是我的代码

server.R

library(shiny)
library(shinydashboard)
library(shinyjs)

shinyServer(function(input, output, session){

output$narrOut <- renderText({
if (input$updtext == 0)
  return("")
isolate({
  tmpchunk<-gsub("\n","<br/>",input$uplchunk)
  gsub("        ","&emsp;",tmpchunk)
})
})

observeEvent(input$symMicr,{
bthing<-js$cursPos(input$uplchunk) #just returns NULL
 updateTextAreaInput(session, inputId = "uplchunk", value = paste(input$uplchunk , "&micro;",sep="")) #just appends symbol at the end of the text... I would like to insert at the cursor position
})

})

ui.R

library(shiny)
library(shinydashboard)
library(shinyjs)


jsCode <- "
shinyjs.cursPos = function(el) {
var pos = 0;
if (document.selection) 
{
  el.focus ();
  var Sel = document.selection.createRange();
  var SelLength = document.selection.createRange().text.length;
  Sel.moveStart ('character', -el.value.length);
  pos = Sel.text.length - SelLength;
}
else if (el.selectionStart || el.selectionStart == '0')
pos = el.selectionStart;
return pos;
}"


header <- dashboardHeader(title = "LNGnote", titleWidth = 300)# how , src="DivTITLE2.png")

textareaInput <- function(inputId, label, value="", placeholder="", rows=2){
  tagList(
    div(strong(label), style="margin-top: 5px;"),
    tags$style(type="text/css", "textarea {width:100%; margin-top: 5px;}"),
    tags$textarea(id = inputId, placeholder = placeholder, rows = rows, value))
}

sidebar <- dashboardSidebar(
  sidebarMenu(
    menuItem("Start Again", href="/", newtab=F, icon=icon("refresh")),
    menuItem("Say Hello :-", href="#", newtab=F),
    menuSubItem("@IPDGC", href="https://twitter.com/pdgenetics", icon = icon("twitter")),
    menuSubItem("IPDGC Page", href="http://pdgenetics.org", icon = icon("eye"))
  )
)

body <- dashboardBody(
    useShinyjs(),
    extendShinyjs(text = jsCode),
  fluidRow(
    #   tabBox(width = 12,
    tabsetPanel(id = "panels",
            ####
            ###
                tabPanel("Notebook",
                     fluidRow(
                       box(title="Notebook Output", status = "info", width=12, solidHeader = T,
                           fluidRow(
                             column(width = 3,
                                    htmlOutput(paste("narrOut")),

                                    HTML("something here<br/>something there")
                             )
                           )
                       )
                     ),
                     fluidRow(
                       column(width=3,
                                   box(title="Recipes", status = "info", solidHeader = T, width=12)
                                   ),
                       column(width=6,
                                   box(title="Export Chunk", status = "info", solidHeader = T, width=12,
                                       h6("insert symbol: "),
                                       actionLink(inputId = "symTab", label = "TAB"),
                                       actionLink(inputId = "symBeta", label = HTML("&beta;")),
                                       actionLink(inputId = "symAlph", label = HTML("&alpha;")),
                                       actionLink(inputId = "symMicr", label = HTML("&micro;")),
                                       textareaInput(inputId = "uplchunk", label = NULL, value = "", rows = 20)
                                   ),
                              actionButton("updtext", "Upload", class = "buttfind")
                       )
                     )
            ),
            tabPanel("Ongoing Notebooks",
                     fluidRow(
                       box(title="Variant Selection", status = "info", width=12, solidHeader = T,
                           fluidRow(
                             column(width = 3,
                                    h2('loggedinas')
                             )
                           )
                       )
                     )
            )
)
)
 )

ui<-dashboardPage(header, sidebar, body, skin = "black")

0 个答案:

没有答案