Search code examples
rshinyhierarchyjstreejstreer

How to delete hierarchical tree elements rendered using the jsTreeR package?


In running the reproducible code below, the user drags elements from the fixed options listed in the "Menu" node at the top of the hierarchy tree to the "Drag here" node underneath. I'm trying to figure out how the user can delete elements in the "Drag here" node, as illustrated at the bottom of this post. Currently I set the jstree option to contextMenu = TRUE, but as illustrated below I don't want users to modify elements in the "Menu" node; and further, within the "Drag here" node, users should only be able to add, delete, and reorder elements (and open children - to come later).

How can this be changed to allow the user to delete elements in "Menu"? My preferences would be simply dragging elements off the grid, a mouse button right-click that shows "Delete" but not Edit/Create/Edit for now (perhaps adding "Add child" and other TBD things later), or a trash bin to drag into.

Reproducible code:

library(jsTreeR)
library(shiny)

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';",
    "}"
  )
)
  
ui <- fluidPage(jstreeOutput("jstree"))  

server <- function(input, output){
  output[["jstree"]] <- renderJstree({
    jstree(
      nodes, 
      dragAndDrop = TRUE, 
      dnd = dnd, 
      checkCallback = checkCallback, 
      contextMenu = TRUE, # << is there a better way so user can only delete items in the ´Drag here´ list?
      types = list(moveable = list(), target = list())
    )
  })

}  

shinyApp(ui, server)

Illustration:

enter image description here


Solution

  • You have to use a custom context menu. You didn't look at the examples cause such an example is given ;-)

    I also added a condition in checkCallback, to prevent some copies inside 'Drag here'.

    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) { console.log(node);",
      "  if(operation === 'copy_node') {",
      "    if(parent.id === '#' || node.parent !== 'j1_1' || 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';",
        "}"
      )
    )
    
    customMenu <- JS(
      "function customMenu(node) {",
      "  var tree = $('#mytree').jstree(true);", # 'mytree' is the Shiny id or the elementId
      "  var items = {",
      "    'delete' : {",
      "      'label'  : 'Delete',",
      "      'action' : function (obj) { tree.delete_node(node); },",
      "      'icon'   : 'glyphicon glyphicon-trash'",
      "     }",
      "  }",
      "  return items;",
      "}")
    
    jstree(
      nodes, dragAndDrop = TRUE, dnd = dnd, checkCallback = checkCallback,
      types = list(moveable = list(), target = list()),
      contextMenu = list(items = customMenu),
      elementId = "mytree" # don't use elementId in Shiny! use the Shiny id
    )