Home > other >  Clear text selection in shiny
Clear text selection in shiny

Time:09-10

i'm new to Shiny and JS is non existent. Looking at this great forum i've built an app that allows users to select data. I however tried to add a 'reset button' so that users can clear their selection to start again but it's not working? i'm not sure how to do this?

library(shiny)

text1 <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Fusce nec quam ut tortor interdum pulvinar id vitae magna. Curabitur commodo consequat arcu et lacinia. Proin at diam vitae lectus dignissim auctor nec dictum lectus. Fusce venenatis eros congue velit feugiat, ac aliquam ipsum gravida. Cras bibendum malesuada est in tempus. Suspendisse tincidunt, nisi non finibus consequat, ex nisl condimentum orci, et dignissim neque est vitae nulla." 
text2 <- "Aliquam ut purus neque. Maecenas justo orci, semper eget purus eu, aliquet molestie mi. Duis convallis ut erat at faucibus. Quisque malesuada ante elementum, tempor felis et, faucibus orci. Praesent iaculis nisi lorem, non faucibus neque suscipit eu. Ut porttitor risus eu convallis tristique. Integer ac mauris a ex maximus consequat eget non felis. Pellentesque quis sem aliquet, feugiat ligula vel, convallis sapien. Ut suscipit nulla leo"
highlight <- '
                function getSelectionText() {
var text = "";
if (window.getSelection) {
text = window.getSelection().toString();
} else if (document.selection) {
text = document.selection.createRange().text;
}
return text;
}

document.onmouseup = document.onkeyup = document.onselectionchange = function() {
var selection = getSelectionText();
Shiny.onInputChange("mydata", selection);
};
'

coded_text <- character(0)

ui <- bootstrapPage(
  tags$script(highlight),
  fluidRow(
    column(4,
           tags$h1("Text to code"),
           tags$h2("From table"),
           tableOutput("table"),
           tags$h2("From raw text"),
           verbatimTextOutput("text"),
           actionButton("vClear", "Clear Selection")
    ),
    column(4,
           tags$h1("Coding options"),
           actionButton("code1", "Assign selected text to Code1"),
           tags$h1("Code1 output"),
           verbatimTextOutput("selected_text")
    )
  )
)


server <- function(input, output) {
  output$table <- renderTable({
    data.frame(paragraph = 1:2, text = c(text1, text2))
  })

  output$text <- renderText(paste(text1, text2))

  coded <- eventReactive(input$code1, {
    coded_text <<- c(coded_text, input$mydata)
    coded_text
  })

  output$selected_text <- renderPrint({
    coded()
  })
  
   observeEvent(input$vClear, {
   coded <- NULL
    coded_text <- NULL
   }) # I tried this but nothing happens!
}

shinyApp(ui = ui, server = server)

Everytime a user clicks on 'Clear Selection' button i'm hoping for the selected text to be reset. Thank you in advance for your help!

CodePudding user response:

We can implement an onclick event for the reset button calling removeAllRanges(). Please check the following:

library(shiny)

text1 <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Fusce nec quam ut tortor interdum pulvinar id vitae magna. Curabitur commodo consequat arcu et lacinia. Proin at diam vitae lectus dignissim auctor nec dictum lectus. Fusce venenatis eros congue velit feugiat, ac aliquam ipsum gravida. Cras bibendum malesuada est in tempus. Suspendisse tincidunt, nisi non finibus consequat, ex nisl condimentum orci, et dignissim neque est vitae nulla." 
text2 <- "Aliquam ut purus neque. Maecenas justo orci, semper eget purus eu, aliquet molestie mi. Duis convallis ut erat at faucibus. Quisque malesuada ante elementum, tempor felis et, faucibus orci. Praesent iaculis nisi lorem, non faucibus neque suscipit eu. Ut porttitor risus eu convallis tristique. Integer ac mauris a ex maximus consequat eget non felis. Pellentesque quis sem aliquet, feugiat ligula vel, convallis sapien. Ut suscipit nulla leo"
highlight <- '
                function getSelectionText() {
var text = "";
if (window.getSelection) {
text = window.getSelection().toString();
} else if (document.selection) {
text = document.selection.createRange().text;
}
return text;
}

document.onmouseup = document.onkeyup = document.onselectionchange = function() {
var selection = getSelectionText();
Shiny.setInputValue("mydata", selection);
};
'
ui <- bootstrapPage(
  tags$script(HTML(highlight)),
  fluidRow(
    column(4,
           tags$h1("Text to code"),
           tags$h2("From table"),
           tableOutput("table"),
           tags$h2("From raw text"),
           verbatimTextOutput("text"),
           actionButton("vClear", "Clear Selection", onclick = 'const reset = function(){Shiny.setInputValue("mydata", ""); window.getSelection()?.removeAllRanges();}; reset();')
    ),
    column(4,
           tags$h1("Coding options"),
           actionButton("code1", "Assign selected text to Code1"),
           tags$h1("Code1 output"),
           verbatimTextOutput("selected_text")
    )
  )
)

server <- function(input, output, session) {
  coded_text <- reactiveVal()
  
  observeEvent(input$code1, {
    coded_text(c(coded_text(), input$mydata))
  })
  
  observeEvent(input$vClear, {
    coded_text(NULL)
  })
  
  output$table <- renderTable({
    data.frame(paragraph = 1:2, text = c(text1, text2))
  })
  
  output$text <- renderText(paste(text1, text2))
  
  output$selected_text <- renderPrint({
    coded_text()
  }) # |> bindEvent(input$code1)
}

shinyApp(ui = ui, server = server)

result

PS: in you should try to avoid global variables and use reactiveVal or reactiveValues instead.

  • Related