Friday, January 26, 2018

Display list of downloads in navbarMenu in shiny

By Hường Hana 8:00 PM , , 1 comment

I would like to add a list of downloads in navebarMenu. I have attempted the following code to do that.

ui.r

 shinyUI(fluidPage(theme = "bootstrap.css", (   navbarPage(     "test",     # id = "navHead",     position = c("fixed-top"),     fluid = TRUE,     selected = "none",     navbarMenu("Help", icon = icon("fa fa-infocircle"),                tabPanel(list(                  a("Reference Manual",                    target = "_blank", href = "Manual.pdf"),                   a("GP Supported",                    target = "_blank", href =                      "gpl.pdf"),                   a(                    "Video Tutorials",                    downloadLink("AE", " Absolute", class =                                   " fa fa-cloud-download"),                    downloadLink("DE", " Diff", class =                                   " fa fa-cloud-download")                  )                )))   ) )))

server.r

shinyServer(function(input, output, session){  })

And it adds an empty line as shown below enter image description here

And it is because tabPanel(). How can I fix it.

I tried also 

tabPanel("abc", a("Manual", target="_blank", href = "Manual.pdf") )

But this line of code is not downloading anything.

1 Answers

Answers 1

Here is how I managed to do it, hope it will be helpful: 

# add custom js handler that will redirect the user when proc'ed     jscode <- "Shiny.addCustomMessageHandler('mymessage', function(message) {window.open('http://www.google.com', '_blank');});" ui <- fluidPage(theme = "bootstrap.css",                 # put custom script on ui to enable it                 tags$head(tags$script(jscode)),                 # we're using uiOutput to be able to use custom dropdown                 uiOutput("a"))  server <- function(input, output, session) {   # function that we'll use to make a fancy dropdown   dropdownMenu <- function(label=NULL, icon=NULL, menu=NULL) {     ul <- lapply(names(menu), function(id) {       if (is.character(menu[[id]])) {         tags$li(actionLink(id, menu[[id]]))       } else {         args <- menu[[id]]         args$inputId <- id         tags$li(do.call(actionLink, args))       }     })     ul$class <- "dropdown-menu"     tags$div(       class = "dropdown",       tags$button(         class = "btn btn-default dropdown-toggle",         type = "button",         `data-toggle` = "dropdown",         label,         `if`(!is.null(icon), icon, tags$span(class="caret"))       ),       do.call(tags$ul, ul)     )   }   output$a <- renderUI({   navbarPage(     tabPanel(       "",       dropdownMenu(         label = "test label",         # "redirect" and "iconed" will be available through input$         menu = list(redirect = "click me to redirect", iconed = list(label = "i can have icons", icon = icon("id-card"))         )       )     )   ) })    #    observeEvent(input$redirect, {     session$sendCustomMessage("mymessage", "mymessage")   })  } shinyApp(ui, server)

Comment if something is unclear.

If You Enjoyed This, Take 5 Seconds To Share It

1 comment: