右键单击上下文菜单以在 R

如何解决右键单击上下文菜单以在 R

我正在尝试从时间 https://visjs.github.io/vis-timeline 库中在 R 中的 timevis 包的时间线中添加一个新组。我想通过单击鼠标右键添加上下文菜单，并可以选择在时间轴中添加或删除组。

if (interactive()) {
  library(shiny)
  library(timevis)
  library(htmlwidgets)
  library(data.table)
  
  rv <- reactiveValues()
  rv$df <- data.frame(
    id = "",start = Sys.Date(),content = "",group = "")
  
  rv$df2 <- data.frame(id = c(1,2),content = c("1","2")) ## This should be added with the contextmenu dynamically
  
  ui <- fluidPage(
    timevisOutput("appts"),div("Selected items:",textoutput("selected",inline = TRUE)),div("Visible window:",textoutput("window",DT::DTOutput("table")
  )
  
  server <- function(input,output) {
    output$appts <- renderTimevis(
      timevis(
        rv$df,groups = rv$df2,options = list(
          editable = TRUE,multiselect = TRUE,align = "center",minorLabels = FALSE,majorLabels = FALSE,onAdd = htmlwidgets::JS(
              'function(item,callback) {
                var end = new Date(item.start);
                item.content = "Rename me!<br/>" + item.content;
                item.end = end.setMonth( end.getMonth() + 1);
      callback(item);
    }'
            ),onRemove = htmlwidgets::JS(
              'function (item,callback) {
        var r = confirm("Press OK to remove or cancel");
        if (r == true) {
              txt = "You pressed OK!";
          callback(item); }
          else {
          txt = "You pressed Cancel!";
          callback(null);
          }
          }'
            ),onUpdate = htmlwidgets::JS(
              'function(item,callback) {
       item.content = prompt("Edit items text:",item.content);
    if (item.content != null) {
      callback(item); // send back adjusted item
    }
    else {
      callback(null); // cancel updating the item
    }
  }'
            )
          )
        )
      )
      
      output$selected <- renderText(paste(input$appts_selected,collapse = " "))
      
      output$window <- renderText(paste(
        input$appts_window[1],"to",input$appts_window[2]
      ))
      
      output[["table"]] <- DT::renderDT({
        DT::datatable(input$appts_data,editable = TRUE)
      })
  }
  shinyApp(ui,server)
}

这是双击item更改名称的reprex，点击X后删除提示，在timevis面板上双击添加item。

文档中提到了以下内容：

上下文菜单

传递方法返回的属性对象

// 在时间轴内右键单击时触发。请注意，按顺序 为了防止上下文菜单出现，默认行为 事件必须停止：

Timeline.getEventProperties(event).   
timeline.on('contextmenu',function (props) {
  alert('Right click!');
  props.event.preventDefault();
});

双击已经完成，但也许可以使用上下文菜单或在时间线左侧双击或使用一些键盘命令+鼠标。我对此完全没有异议，您的支持会很棒。

最好，

特奥