From 653ef9394fe63731a7f6f08c0bef83e1553229e3 Mon Sep 17 00:00:00 2001
From: Kevin Ushey <kevinushey@gmail.com>
Date: Wed, 10 Jul 2024 17:19:11 +0800
Subject: [PATCH] use custom (extended) timeout for showDialog

---
 DESCRIPTION       |  2 +-
 R/dialogs.R       | 27 +++++++++++++++++++--------
 R/remote.R        | 13 +++++++------
 man/showDialog.Rd | 17 +++++++++++------
 4 files changed, 38 insertions(+), 21 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 261d2f3..7b8cdd1 100644
--- a/DESCRIPTION
+++ b/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,
diff --git a/R/dialogs.R b/R/dialogs.R
index 333c4d4..bee7ba6 100644
--- a/R/dialogs.R
+++ b/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)
 }
 
diff --git a/R/remote.R b/R/remote.R
index f0d8f64..af5ad60 100644
--- a/R/remote.R
+++ b/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
diff --git a/man/showDialog.Rd b/man/showDialog.Rd
index 3e18d85..04728c2 100644
--- a/man/showDialog.Rd
+++ b/man/showDialog.Rd
@@ -4,7 +4,7 @@
 \alias{showDialog}
 \title{Show Dialog Box}
 \usage{
-showDialog(title, message, url = "")
+showDialog(title, message, url = "", timeout = 60)
 }
 \arguments{
 \item{title}{The title to display in the dialog box.}
@@ -13,15 +13,20 @@ showDialog(title, message, url = "")
 dialog area. Contents can contain the following HTML tags: "p", "em",
 "strong", "b" and "i".}
 
-\item{url}{An optional url to display under the \code{message}.}
+\item{url}{An optional URL to display under the \code{message}.}
+
+\item{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.}
 }
 \description{
 Shows a dialog box with a given title and contents.
 }
-\details{
-\preformatted{ showDialog("A dialog", "Showing <b>bold</b> text in the
-message.") }
-}
 \note{
 The \code{showDialog} function was added in version 1.1.67 of RStudio.
 }
+\examples{
+if (rstudioapi::isAvailable()) {
+  rstudioapi::showDialog("Example Dialog", "This is an <b>example</b> dialog.")
+}
+
+}