javascriptrshinyjstreejstreer

How to prevent dropping branch nodes on leaf nodes with library(jsTreeR)


This is a follow-up post on my earlier question here.

@StéphaneLaurent and @ismirsehregal provided me with some great input on how to customize jsTreeR's context menu:

library(jsTreeR)
library(shiny)

nodes <- list(
  list(
    text = "Branch 1",
    state = list(opened = TRUE, disabled = FALSE),
    type = "parent",
    children = list(
      list(text = "Leaf A", type = "undeletable", state = list(disabled = FALSE), data = list(customdata = 1)),
      list(text = "Leaf B", type = "undeletable", state = list(disabled = FALSE), data = list(customdata = 2)),
      list(text = "Leaf C", type = "undeletable", state = list(disabled = FALSE), data = list(customdata = 3)),
      list(text = "Leaf D", type = "undeletable", state = list(disabled = FALSE), data = list(customdata = 4))
    )
  ),
  list(text = "Branch 2", type = "parent", state = list(opened = TRUE))
)

ui <- fluidPage(
  jstreeOutput("mytree")
)

customMenu <- JS(
  "function customMenu(node) {
  var tree = $('#mytree').jstree(true);
  var items = {
    'rename' : {
      'label' : 'Rename',
      'action' : function (obj) { tree.edit(node); },
      'icon': 'glyphicon glyphicon-edit'
    },
    'delete' : {
      'label' : 'Delete',
      'action' : function (obj) { tree.delete_node(node); },
      'icon' : 'glyphicon glyphicon-trash'
    },
    'create' : {
      'label' : 'Create',
      'action' : function (obj) { tree.create_node(node); },
      'icon': 'glyphicon glyphicon-plus'
    }
  }
  
  if (node.children.length > 0) { items.delete._disabled = true; }
  if (node.type === 'undeletable') { items.rename._disabled = true;
                                     items.delete._disabled = true;
                                     items.create._disabled = true;
                                    }

  return items;
}")

server <- function(input, output, session){
  output[["mytree"]] <- renderJstree({
    suppressMessages(jstree(
      nodes,
      search = list(
        show_only_matches = TRUE,
        case_sensitive = FALSE,
        search_leaves_only = FALSE
      ),
      dragAndDrop = TRUE,
      multiple = TRUE,
      contextMenu = list(items = customMenu),
      types = list(default = list(icon = "fa fa-caret-right"), undeletable = list(icon = "fa-solid fa-leaf"), parent = list(icon = "fa-brands fa-pagelines")),
      theme = "proton"
    ))
  })
}  

shinyApp(ui, server)

However, on top of that I'd like to prevent dropping branch nodes on leaf nodes.

Accordingly, instead of configuring it for the whole tree (dragAndDrop = TRUE) I'd like to distinguish between different node types:

Allowed:

ok


Not allowed:

nok


Solution

  • I think you just need:

    dnd <- list(
      is_draggable = JS(
        "function(node) {",
        "  return node[0].type !== 'parent';",
        "}"
      )
    )
    
    jstree(
      nodes,
      dragAndDrop = TRUE, dnd = dnd,
      types = ......,
      checkCallback = TRUE
    )
    

    In this way, branch nodes are not draggable. Is it what you want?


    EDIT

    Regarding your comment:

    checkCallback <- JS(
      "function(operation, node, parent, position, more) {",
      "  if(operation === 'move_node') {",
      "    if(parent.id === '#' || parent.type !== 'parent') {",
      "      return false;", # prevent moving a child above or below the root
      "    }",               # and moving inside a child
      "  }",
      "  return true;", # allow everything else
      "}"
    )
    
    jstree(
      nodes,
      dragAndDrop = TRUE, 
      types = ......,
      checkCallback = checkCallback
    )