右键单击数据表时打开上下文菜单

Question

我想在右键单击数据表的一行时打开上下文菜单。 然后，上下文菜单将向用户建议打开文件的选项，该文件的路径存储在数据表的相应行中，即在

Path

列中。我怎样才能做到这一点？下面是一个简单的例子：

library(shiny)
library(DT)

ui <- fluidPage(
  DTOutput("myTable")
)

server <- function(input, output, session) {
  data <- data.frame(
    Name = c("File1", "File2", "File3"),
    Path = c("C:/Path/File1.txt", "C:/Path/File2.txt", "C:/Path/File3.txt")
  )
  
  output$myTable <- renderDT({
    datatable(data, escape = FALSE)
  })

}

shinyApp(ui, server)

Answer 1

这是一种使用 JavaScript 库 jQueryContextMenu 的方法。

library(shiny)
library(DT)
library(pander) # to use openFileInOS()

ui <- fluidPage(
  tags$head(
    tags$link(rel="stylesheet", href="https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.9.2/jquery.contextMenu.min.css"),
    tags$script(src="https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.9.2/jquery.contextMenu.min.js"),
    tags$script(src="https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.9.2/jquery.ui.position.js")
  ),
  br(),
  DTOutput("dtable")
)

dat <- data.frame(
  XXXXX = c("hello", "morning"),
  files = c("C:/SL/test1.txt", "C:/SL/test2.txt") 
)

callback <- c(
  "$.contextMenu({",
  "  selector: '#dtable tr',", 
  "  trigger: 'right',",
  "  autoHide: true,",
  "  items: {",
  "    open: {",
  "      name: 'Open file',", 
  "      callback: function(itemKey, opts, e){",
  "        let i = $(this).index() + 1;",
  "        Shiny.setInputValue('index', i, {priority: 'event'});",
  "      }",
  "    }",
  "  }",
  "});"
)

server <- function(input, output, session) {
  
  output[["dtable"]] <- renderDT({
    datatable(
      dat,
      selection = "none",
      callback = JS(callback)
    )
  })
  
  observeEvent(input[["index"]], {
    file <- dat[["files"]][input[["index"]]]
    openFileInOS(file)
  })
  
}

shinyApp(ui, server)