R 自定义加载器显示在闪亮应用程序的输出创建过程开始之前

我在下面有一个闪亮的仪表板，在仪表板中，如果我给出一个名称，除了默认的

同意。名称

，则给出密码

makis

，然后按

开始

生成rmd输出。 正如您将看到的，在创建报告时，会显示一条加载消息。问题是，在执行任何操作之前，都会显示此加载消息，这很令人困惑。只有当

名称

和

密码

输入正确且按下

入门操作按钮（）

时，如何才能显示此加载消息？我认为使用withLoader（）创建的加载消息应该从

ui

移动到

服务器的
部分，以便遵循与rmarkdown
uiOutput（）相同的逻辑

前rmd

---
title: "An example Knitr/R Markdown document"
output: pdf_document
---


{r chunk_name, include=FALSE}
x <- rnorm(100)
y <- 2*x + rnorm(100)
cor(x, y)

---
标题：“Knitr/R降价文档示例”
输出：pdf\U文件
---
{r chunk_name，include=FALSE}
x
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(knitr)
library(shinycustomloader)
dbHeader <- dashboardHeaderPlus(
  titleWidth = "0px",
  tags$li(a(
    div(style="display: inline;margin-top:25px; padding: 0px 0px 0px 1250px;vertical-align:top; width: 150px;", actionButton("well", "Welcome")),

  ),
  class = "dropdown")
  
  
)

shinyApp(
  ui = dashboardPagePlus(
    header = dbHeader,
    sidebar = dashboardSidebar(width = "0px",
                               sidebarMenu(id = "sidebar", # id important for updateTabItems
                                           menuItem("Welcome", tabName = "well", icon = icon("house"))
                               )           ),
    body = dashboardBody(
      
      useShinyjs(),
      tags$script(HTML("$('body').addClass('fixed');")),
      
      tags$head(tags$style(".skin-blue .main-header .logo { padding: 0px;}")),
      tabItems(
        tabItem("well",
                fluidRow(),
                tags$hr(),
                tags$hr(),
                fluidRow(
                  fluidRow(textInput("name", label = ("Name"), value = "consent.name")),
                  passwordInput("pwd", "Enter the Database browser password"),
                  withLoader(uiOutput('markdown'),type="html",loader = "loader1"),
                  actionButton("button", "Get started",style='padding:4px; font-size:140%')
                  ))
       
      )
      
      
    )
    
  ),
  server<-shinyServer(function(input, output,session) { 
    hide(selector = "body > div > header > nav > a")
    
    observeEvent(input$button,{
      if (input$name=="consent.name"){
        return(NULL)
      }
      else{
        if(input$pwd=="makis"){
          output$markdown <- renderUI({
            HTML(markdown::markdownToHTML(knit('ex.rmd', quiet = TRUE)))
          })
          
        }
        else{
          return(NULL)
        }
      }
    })
    
  }
  )
)