Shiny应用中清除文本选中状态功能失效问题求助

问题分析 #

你的代码存在两个核心问题：

• 页面文本的选中状态无法通过R代码直接清除，必须借助JavaScript实现取消选择的逻辑。
• 全局变量coded_text的重置逻辑错误，且使用全局变量不符合Shiny响应式编程规范，导致selected_text输出无法同步更新。

修正后的完整代码 #

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;
}

// 监听选择变化并同步到Shiny
document.onmouseup = document.onkeyup = document.onselectionchange = function() {
  var selection = getSelectionText();
  Shiny.onInputChange("mydata", selection);
};

// 新增：取消文本选中状态的函数
function clearTextSelection() {
  if (window.getSelection) {
    window.getSelection().removeAllRanges();
  } else if (document.selection) {
    document.selection.empty();
  }
  // 同步重置Shiny端的选中值
  Shiny.onInputChange("mydata", "");
}

// 监听Shiny发送的清除信号
Shiny.addCustomMessageHandler("clearSelection", function(message) {
  clearTextSelection();
});
'

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, session) {
  # 用reactiveVal替代全局变量，符合Shiny响应式逻辑
  coded_text <- reactiveVal(character(0))
  
  output$table <- renderTable({
    data.frame(paragraph = 1:2, text = c(text1, text2))
  })

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

  # 更新已编码文本
  observeEvent(input$code1, {
    if(input$mydata != ""){
      coded_text(c(coded_text(), input$mydata))
    }
  })

  output$selected_text <- renderPrint({
    coded_text()
  })
  
  # 处理清除按钮逻辑
  observeEvent(input$vClear, {
    # 重置已编码文本列表
    coded_text(character(0))
    # 发送信号给JS，清除页面文本选中状态
    session$sendCustomMessage("clearSelection", list())
  })
}

shinyApp(ui = ui, server = server)

关键修改说明 #

1. 新增JavaScript清除逻辑：

   • 添加clearTextSelection函数，兼容不同浏览器实现文本选中状态的取消操作。
   • 通过Shiny.addCustomMessageHandler建立R与JS的通信，点击清除按钮时，R端触发JS执行清除操作，同时重置Shiny的mydata输入值。

2. 替换全局变量为reactiveVal：

   • 用reactiveVal管理已编码文本，避免全局变量的副作用，确保响应式输出能实时更新。
   • 在清除按钮的响应逻辑中，直接调用coded_text(character(0))重置内容，触发selected_text输出同步更新。

3. 优化编码逻辑：

   • 增加空值判断，避免选中空文本时向编码列表添加无效内容。

内容的提问来源于stack exchange，提问作者tezzaaa