Skip to content

Pressing Done should close browser window #3

@homerhanumat

Description

@homerhanumat

Suppose an Addin is written to open in a browser window. When the user clicks the Done button, the window darkens but does not disappear. It seems that the window should be made to disappear. However, when I write the app so as to force this action, I see no effect. For example, consider the following modification of the subset Addin:

library(miniUI)
subsetAddin2 <- function() {

  # Get the document context.
  context <- rstudioapi::getActiveDocumentContext()

  # Set the default data to use based on the selection.
  text <- context$selection[[1]]$text
  defaultData <- text

  #code to close browser window when done
  jscode <- "Shiny.addCustomMessageHandler('closeWindow', function(m) {window.close();});"

  # Generate UI for the gadget.
  ui <- miniPage(
    tags$head(tags$script(HTML(jscode))),
    gadgetTitleBar("Subset a data.frame"),
    miniContentPanel(
      stableColumnLayout(
        textInput("data", "Data", value = defaultData),
        textInput("subset", "Subset Expression")
      ),
      uiOutput("pending"),
      dataTableOutput("output")
    )
  )


  # Server code for the gadget.
  server <- function(input, output, session) {

    reactiveData <- reactive({

      # Collect inputs.
      dataString <- input$data
      subsetString <- input$subset

      # Check to see if there is data called 'data',
      # and access it if possible.
      if (!nzchar(dataString))
        return(errorMessage("data", "No dataset available."))

      if (!exists(dataString, envir = .GlobalEnv))
        return(errorMessage("data", paste("No dataset named '", dataString, "' available.")))

      data <- get(dataString, envir = .GlobalEnv)

      if (!nzchar(subsetString))
        return(data)

      # Try evaluating the subset expression within the data.
      condition <- try(parse(text = subsetString)[[1]], silent = TRUE)
      if (inherits(condition, "try-error"))
        return(errorMessage("expression", paste("Failed to parse expression '", subsetString, "'.")))

      call <- as.call(list(
        as.name("subset.data.frame"),
        data,
        condition
      ))

      eval(call, envir = .GlobalEnv)
    })

    output$pending <- renderUI({
      data <- reactiveData()
      if (isErrorMessage(data))
        h4(style = "color: #AA7732;", data$message)
    })

    output$output <- renderDataTable({
      data <- reactiveData()
      if (isErrorMessage(data))
        return(NULL)
      data
    })

    # Listen for 'done'.
    observeEvent(input$done, {
      # send message to close the window:
      session$sendCustomMessage(type = "closeWindow", message = "message")
      # Emit a subset call if a dataset has been specified.
      if (nzchar(input$data) && nzchar(input$subset)) {
        code <- paste("subset(", input$data, ", ", input$subset, ")", sep = "")
        rstudioapi::insertText(text = code)
      }

      invisible(stopApp())
    })
  }

  # Use a browser as a viewer.
  viewer <- browserViewer()
  runGadget(ui, server, viewer = viewer)

}

subsetAddin2()

I can verify that message-handler script makes it into the head of the document, but the message sent in observeEvent() appears to be ignored. Am I doing something wrong?

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions