Search code examples
rshinyshinytreejstreer

How to copy specified items rather than moving when using drag and drop in the shinyTree package?


I am trying out the shinyTree package to see if it works for my hierarchy tree needs, per post How to build a drag and drop hierarchical tree with user inputs using shinyTree, jsTreeR, or similar package?.

In the following reproducible code, the intent is for the user to copy items from the "Menu" section to the "Drag here" section. Instead, the code below moves the dragged items, deleting them from the "Menu" section. How would I change this so that dragged elements are copied instead and not lost from "Menu"? (Similar to "cloning" in sortable package, see post How to replenish the bucket list when running the sortable package?).

Additionally (perhaps this is better left for a subsequent post?), I´d like to "fix" the menu section so the user can't make any changes to it: can't reorder, can't delete, can't add. The user should only be able to copy those items.

The image at the bottom illustrates the issue.

Reproducible code:

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)

enter image description here


Solution

  • Here is the way with jsTreeR. I also prevented some moves, a move is allowed only if the target is the "Drag here" node.

    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())
    )
    

    enter image description here