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

@@ -2,17 +2,28 @@
 #' 
 #' 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 An optional 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)
 }
 

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