1

I am able to render a sortable list of menuSubItems using this question, but I'd like to keep track of the order that they're in after being sorted. menuSubItems don't show up in input on the server side (at least not the whole list), and I'd like to be able to have a way to access the order of the list of values in test_tabs without having to delve into creating custom input bindings in Shiny.

Any creative ideas would be appreciated!

library(shiny)
library(shinydashboard)
library(sortable)

# Define UI for shinydashboard
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("tab_one", tabName = "test_body"),
      menuItemOutput("test")
    )
  ),
  dashboardBody(
    tabItem("test_body", actionButton("click_me", "Click Me"))
  )
)

# Define server logic to dynamically create menuSubItems
server <- function(input, output) {
  observeEvent(input$click_me, {
    tabs_list <- lapply(1:5, function(x) {
      menuSubItem(text = paste("tab", x))
    })

    output$test <- renderMenu({
      menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
      menu$children[[2]] <- tagAppendAttributes(menu$children[[2]], id = "test_tabs")
      tagAppendChildren(menu, sortable_js("test_tabs"))
    })
  })
}

# Run the application
shinyApp(ui = ui, server = server)
code_cowboy
  • 596
  • 5
  • 18

1 Answers1

2

You can use an option from sortable_js to get an event when order changes and fire an event to notify shiny

server <- function(input, output) {
  observeEvent(input$click_me, {
    tabs_list <- lapply(1:5, function(x) {
      menuSubItem(text = paste("tab", x))
    })

    output$test <- renderMenu({
      menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
      menu$children[[2]] <- tagAppendAttributes(menu$children[[2]], id = "test_tabs")

      # this javascript function will listen to onUpdate event fired by
      # sortable_js when reordering happened. From this event we get 'from'
      # that refers to the container whose items are reordered (our test_tab)
      # then it's content (items) as text (Maybe better to get items from DOM ...)
      # And finally send an event to shiny using Shiny.setInputValue
      update_notifier <- htmlwidgets::JS("function(evt) { Shiny.setInputValue('test_tabs_order',evt.from.innerText);}")

      # add an option to declare our update_notifier to the sortable menu
      tagAppendChildren(menu, sortable_js("test_tabs", options=sortable_options(onUpdate=update_notifier)))
    })

  })

  # listen to the event input fired by onUpdate listener above
  # we get a newline separated list of item text
  # after a bit of formatting we have now a vector of item text
  observeEvent(input$test_tabs_order, {
    ord <- input$test_tabs_order
    ord <- gsub("(^\\s*)|(\\s*$)","", ord) # trim
    ord <- unlist(strsplit(ord,"\\s*\n\\s*")) # split
    # ord is now a vector of reordered item text 
    message(paste(ord,collapse=","))
  })

Alternate method sending an array of item text

 update_notifier <- htmlwidgets::JS("function(evt) {
   var a=evt.from.children; 
   var b=[]; 
   for(idx=0;idx<a.length;idx++) {
     b[idx]=a[idx].innerText;
   };
   Shiny.setInputValue('test_tabs_order',b);
  }")
Billy34
  • 1,777
  • 11
  • 11