如何在shinyTree包中使用拖放时复制指定项而不是移动？

Question

我正在试用shinyTree包，看看它是否适合我的层次结构树需要，每个post How to build a drag and drop hierarchical tree with user inputs using shinyTree, jsTreeR, or similar package?。

在下面的可复制代码中，目的是让用户将项目从“菜单”部分复制到“拖动此处”部分。相反，下面的代码移动拖动的项目，从“菜单”部分删除它们。我如何改变这种情况，使拖动的元素被复制而不是从“菜单”中丢失？(类似于可排序包中的“克隆”，请参见post How to replenish the bucket list when running the sortable package?)。

另外(也许这最好留给后续的帖子？)，我想“修复”菜单部分，这样用户就不能对它做任何更改:不能重新排序，不能删除，不能添加。用户应该只能复制这些项目。

底部的图像说明了这个问题。

可复制代码：

library(shiny)
library(shinyTree)

ui <- fluidPage(
  pageWithSidebar(
    headerPanel("shinyTree!"),
    sidebarPanel(helpText(HTML("Created using <a href = \"http://github.com/trestletech/shinyTree\">shinyTree</a>."))),
    mainPanel(shinyTree("tree", 
                        stripes = TRUE, 
                        multiple = TRUE, 
                        animation = FALSE, 
                        dragAndDrop = TRUE, 
                        contextmenu = TRUE
                        )
              )
  )
)

server <- function(input, output, session) {
  output$tree <- renderTree({
    list(
      'Menu' = list(A = "", B = "", C = "", D = ""),
      'Drag here:' = list("")
    )
  })
}

shinyApp(ui, server)

​

​

Answer 1

这是使用jsTreeR的方法。我还阻止了一些移动，只有当目标是“拖动这里”节点时，才允许移动。

library(jsTreeR)

nodes <- list(
  list(
    text = "Menu",
    state = list(opened = TRUE),
    children = list(
      list(
        text = "A",
        type = "moveable",
        state = list(disabled = TRUE)
      ),
      list(
        text = "B",
        type = "moveable",
        state = list(disabled = TRUE)
      ),
      list(
        text = "C",
        type = "moveable",
        state = list(disabled = TRUE)
      ),
      list(
        text = "D",
        type = "moveable",
        state = list(disabled = TRUE)
      )
    )
  ),
  list(
    text = "Drag here:",
    type = "target",
    state = list(opened = TRUE)
  )
)

checkCallback <- JS(
  "function(operation, node, parent, position, more) {",
  "  if(operation === 'copy_node') {",
  "    if(parent.id === '#' || parent.type !== 'target') {",
  "      return false;", # prevent moving an item above or below the root
  "    }",               # and moving inside an item except a 'target' item
  "  }",
  "  return true;",      # allow everything else
  "}"
)

dnd <- list(
  always_copy = TRUE,
  is_draggable = JS(
    "function(node) {",
    "  return node[0].type === 'moveable';",
    "}"
  )
)

jstree(
  nodes, dragAndDrop = TRUE, dnd = dnd, checkCallback = checkCallback,
  types = list(moveable = list(), target = list())
)

​

​