在函数中创建的 ModalDialog 在第二次/第四次/第六次等调用时瞬间关闭

ModalDialog created in a function closes in a flash at second / fourth / sixth etc. call

我正在构建一个大型且(对我来说)复杂的 r shiny 应用程序,我允许人们在其中对一长串文本进行分类。

每当他们想要将以前不存在的标签添加到类别时,就会弹出一个 modalDialog。现在不重要的是,在该对话框中需要完成什么。那是在控制之中。 (我要感谢整个 Whosebug 社区:在之前发布的问题和答案的帮助下,我拼凑出了我的解决方案——这是一个很棒的平台)。

但是,问题来了:第一个文本获得一个新类别,modalDialog 弹出,允许所有必要的操作并在点击 'save' 按钮时执行所需的操作。取消按钮也是如此。

然后第二次调用 modalDialog,它短暂出现,但随后立即自动关闭(通过与第一次关闭对话框相同的事件)。第三次一切都很好。第四次出现闪现等情况。还有,那个关闭事件的执行次数会随着每次试次的增加而增加?

我在下面的简化代码中重现了这种情况。单击按钮 1,它会打开并显示相应的信息。单击保存,它关闭(并只显示一次调试消息)。点击按钮 2:闪光! (和调试消息的两倍)。再次单击按钮 2(或 1,随便什么):一切正常。

我试着让 observeEvents 中的代码有条件。我尝试将会话传递给 removeModal 函数。不工作。尝试使用 modalButtons 而不是 actionButtons,但它们没有 id,然后我无法点击。保存和取消不应该只是关闭 modal.They 需要执行一些代码(在真实版本中)所以我需要能够区分它们。

有人可以给我提示吗?将不胜感激!这段代码不知何故陷入了循环,并希望将其从循环中解救出来。

library(shiny)

ui <- (fluidPage(
  actionButton(inputId = "button1", label = "Button 1"),
  actionButton(inputId = "button2", label = "Button 2")
))

server <- function(session, input, output) {
  observeEvent(input$button1, {
    session = session
    modalId = 'newLabel'
    label = "button1"
    text = "This is text 1"
    myToggleModal(session, modalId, label, text)
  })
  
  observeEvent(input$button2, {
    session = session
    modalId = 'newLabel'
    label = "button2"
    text = "This is text 2"
    myToggleModal(session, modalId, label, text)
  })
  
  myToggleModal <- function(session, modalId, label, text){
    varLabel <- label
    varText <- text
    
    showModal(
      tagList(
        modalDialog(
          title = '',
          htmlOutput(outputId = "output1"),
          hr(),
          htmlOutput("output2"),
          br(),br(),
          footer = tagList(
            actionButton("cancel", "Cancel"),
            actionButton("save", "Save")
          )
        )
      )
    )
    
    
    output$output1 <- renderUI({
      varLabel
    })
    
    output$output2 <- renderUI({ # display the marked-up text
      text
    })
    
    observeEvent(input$save,{
      ##do something
      
      #print the debugging message
      print("you are passing the save event")
      removeModal()
    })
    
    observeEvent(input$cancel,{
      ##don't do that something
      
      #print the debugging message
      print("you are passing the cancel event")
      removeModal()
    })
  }
}
  
shinyApp(ui, server)

这是部分答案:我应该已经确定了模块中操作按钮的名称空间。我为我的代码改编了 并且有效。 现在仍然需要找到一种将信息传递给模块的新方法,但这与这个特定问题无关。

modalModuleUI <- function(id, label) {
  ns <- NS(id)
  actionButton(ns(label), gsub(pattern = "button", x = label, replacement = "Button "))
}

modalModule <- function(input, output, session) {
  
  myModal <- function() {
    ns <- session$ns
      modalDialog(
        title = '',
        htmlOutput(outputId = ns("output1")),
        hr(),
        htmlOutput(ns("output2")),
        br(),br(),
        footer = tagList(
          actionButton(ns("cancel"), "Cancel"),
          actionButton(ns("save"), "Save")
        )
      )
  }
  
  # open modal on button click
  observeEvent(input$button1,
               ignoreNULL = TRUE, {
                 showModal(myModal())
               }
  )
  
  observeEvent(input$button2,
               ignoreNULL = TRUE, {
                 showModal(myModal())
               }
  )
  
  # close modal on button click
  observeEvent(input$save, { 
    print("save")
    removeModal() 
  })
  
  observeEvent(input$cancel, { 
    print("cancel")
    removeModal() 
  })
}


ui <- fluidPage(
  modalModuleUI("foo", "button1"), 
  modalModuleUI("foo", "button2")
  )

server <- function(input, output, session) {
  callModule(modalModule, "foo")
}
  
shinyApp(ui, server)