Question

我想在navebarMenu中添加下载列表。我尝试了以下代码来做到这一点。

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

})

它添加一个空行，如下所示

这是因为tabPanel()。我该如何解决呢？

我也尝试了

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

但是这行代码没有下载任何内容。

Answer 1

以下是我设法做到的方式，希望它会有所帮助：

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

评论是否有不明确的事情。

显示navbarMenu中有光泽的下载列表

1 个答案: