Merge pull request #303 from rstudio/feature/show-dialog-timeout

use custom (extended) timeout for showDialog

DESCRIPTION

@@ -16,7 +16,7 @@ URL: https://rstudio.github.io/rstudioapi/,
     https://github.com/rstudio/rstudioapi
 BugReports: https://github.com/rstudio/rstudioapi/issues
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Suggests:
     testthat,
     knitr,

R/dialogs.R

@@ -1,32 +1,43 @@
 #' Show Dialog Box
-#' 
+#'
 #' Shows a dialog box with a given title and contents.
-#' 
-#' \preformatted{ showDialog("A dialog", "Showing <b>bold</b> text in the
-#' message.") }
-#' 
+#'
 #' @param title The title to display in the dialog box.
+#'
 #' @param message A character vector with the contents to display in the main
-#' dialog area. Contents can contain the following HTML tags: "p", "em",
-#' "strong", "b" and "i".
-#' @param url An optional url to display under the \code{message}.
+#'   dialog area. Contents can contain the following HTML tags: "p", "em",
+#'   "strong", "b" and "i".
+#'
+#' @param url An optional URL to display under the \code{message}.
+#'
+#' @param timeout A timeout (in seconds). When set, if the user takes
+#'   longer than this timeout to provide a response, the request will be aborted.
+#'
 #' @note The \code{showDialog} function was added in version 1.1.67 of RStudio.
-#' @export showDialog
-showDialog <- function(title, message, url = "") {
+#'
+#' @examples
+#' if (rstudioapi::isAvailable()) {
+#'   rstudioapi::showDialog("Example Dialog", "This is an <b>example</b> dialog.")
+#' }
+#'
+#' @export
+showDialog <- function(title, message, url = "", timeout = 60) {
+  opts <- options(rstudioapi.remote.timeout = timeout)
+  on.exit(options(opts), add = TRUE)
   callFun("showDialog", title, message, url)
 }
 
 
 
 #' Updates a Dialog Box
-#' 
+#'
 #' Updates specific properties from the current dialog box.
-#' 
+#'
 #' Currently, the only dialog with support for this action is the New
 #' Connection dialog in which the code preview can be updated through this API.
-#' 
+#'
 #' \preformatted{ updateDialog(code = "con <- NULL") }
-#' 
+#'
 #' @param ... Named parameters and values to update a dialog box.
 #' @note The \code{updateDialog} function was added in version 1.1.67 of
 #' RStudio.
@@ -38,39 +49,57 @@ updateDialog <- function(...) {
 
 
 #' Show Prompt Dialog Box
-#' 
+#'
 #' Shows a dialog box with a prompt field.
-#' 
-#' 
+#'
+#'
 #' @param title The title to display in the dialog box.
+#'
 #' @param message A character vector with the contents to display in the main
-#' dialog area.
+#'   dialog area.
+#'
 #' @param default An optional character vector that fills the prompt field with
-#' a default value.
+#'   a default value.
+#'
+#' @param timeout A timeout (in seconds). When set, if the user takes
+#'   longer than this timeout to provide a response, the request will be aborted.
+#'
 #' @note The \code{showPrompt} function was added in version 1.1.67 of RStudio.
+#'
 #' @export showPrompt
-showPrompt <- function(title, message, default = NULL) {
+showPrompt <- function(title, message, default = NULL, timeout = 60) {
+  opts <- options(rstudioapi.remote.timeout = timeout)
+  on.exit(options(opts), add = TRUE)
   callFun("showPrompt", title, message, default)
 }
 
 
 
 #' Show Question Dialog Box
-#' 
+#'
 #' Shows a dialog box asking a question.
-#' 
-#' 
+#'
 #' @param title The title to display in the dialog box.
+#'
 #' @param message A character vector with the contents to display in the main
-#' dialog area.
+#'   dialog area.
+#'
 #' @param ok And optional character vector that overrides the caption for the
-#' OK button.
+#'   OK button.
+#'
 #' @param cancel An optional character vector that overrides the caption for
-#' the Cancel button.
+#'   the Cancel button.
+#'
+#' @param timeout A timeout (in seconds). When set, if the user takes
+#'   longer than this timeout to provide a response, the request will be aborted.
+#'
 #' @note The \code{showQuestion} function was added in version 1.1.67 of
-#' RStudio.
+#'   RStudio.
+#'
 #' @export showQuestion
-showQuestion <- function(title, message, ok = NULL, cancel = NULL) {
+showQuestion <- function(title, message, ok = NULL, cancel = NULL, timeout = 60) {
+  opts <- options(rstudioapi.remote.timeout = timeout)
+  on.exit(options(opts), add = TRUE)
   callFun("showQuestion", title, message, ok, cancel)
 }
 
@@ -80,18 +109,18 @@ showQuestion <- function(title, message, ok = NULL, cancel = NULL) {
 #'
 #' Request a secret from the user. If the `keyring` package is installed, it
 #' will be used to cache requested secrets.
-#' 
-#' 
+#'
+#'
 #' @param name The name of the secret.
-#' 
+#'
 #' @param message A character vector with the contents to display in the main
 #'   dialog area.
-#'   
+#'
 #' @param title The title to display in the dialog box.
-#' 
+#'
 #' @note The \code{askForSecret} function was added in version 1.1.419 of
 #'   RStudio.
-#' 
+#'
 #' @export
 askForSecret <- function(
   name,

R/remote.R

@@ -39,7 +39,7 @@ callRemote <- function(call, frame) {
   # check for active request / response
   requestFile  <- Sys.getenv("RSTUDIOAPI_IPC_REQUESTS_FILE", unset = NA)
   responseFile <- Sys.getenv("RSTUDIOAPI_IPC_RESPONSE_FILE", unset = NA)
-  secret   <- Sys.getenv("RSTUDIOAPI_IPC_SHARED_SECRET", unset = NA)
+  secret       <- Sys.getenv("RSTUDIOAPI_IPC_SHARED_SECRET", unset = NA)
   if (is.na(requestFile) || is.na(responseFile) || is.na(secret))
     stop("internal error: callRemote() called without remote connection")
 
@@ -50,17 +50,17 @@ callRemote <- function(call, frame) {
   attr(call, "srcref") <- NULL
 
   # ensure rstudioapi functions get appropriate prefix
-  if (is.name(call[[1L]])) {
-    call_fun <- call("::", as.name("rstudioapi"), call[[1L]])
+  callFun <- if (is.name(call[[1L]])) {
+     call("::", as.name("rstudioapi"), call[[1L]])
   } else {
-    call_fun <- call[[1L]]
+    call[[1L]]
   }
 
   # ensure arguments are evaluated before sending request
   call[[1L]] <- quote(base::list)
   args <- eval(call, envir = frame)
 
-  call <- as.call(c(call_fun, args))
+  call <- as.call(c(callFun, args))
 
   # write to tempfile and rename, to ensure atomicity
   data <- list(secret = secret, call = call)
@@ -72,6 +72,7 @@ callRemote <- function(call, frame) {
   # in theory we'd just do a blocking read but there isn't really a good
   # way to do this in a cross-platform way without additional dependencies
   now <- Sys.time()
+  timeout <- getOption("rstudioapi.remote.timeout", default = 10)
   repeat {
 
     # check for response
@@ -80,7 +81,7 @@ callRemote <- function(call, frame) {
 
     # check for lack of response
     diff <- difftime(Sys.time(), now, units = "secs")
-    if (diff > 10)
+    if (diff > timeout)
       stop("RStudio did not respond to rstudioapi IPC request")
 
     # wait a bit

rstudioapi.Rproj

@@ -13,6 +13,7 @@ RnwWeave: Sweave
 LaTeX: pdfLaTeX
 
 AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
 
 BuildType: Package
 PackageUseDevtools: Yes