[rkward] rkward/rbackend/rpackages/rkward/R: added rk.askYesNo() and marked rk.show.question() as deprecated

[m.eik michalke]

Git commit 965c17cc7c93db27f3fb1c8f2c8297d629b2292d by m.eik michalke.
Committed on 16/05/2018 at 15:11.
Pushed by meikm into branch 'master'.

added rk.askYesNo() and marked rk.show.question() as deprecated

  - the arguments of rk.askYesNo() are modelled after the askYesNo() function introduced with R 3.5
  - but there are some differences: the first argument is called "message" (not "msg") like in rk.show.question(), it still supports the "caption" argu
  - in contrast to rk.show.question(), it returns NA if cancelled, not NULL

M  +49   -0    rkward/rbackend/rpackages/rkward/R/rk.KDE_GUI-functions.R

https://commits.kde.org/rkward/965c17cc7c93db27f3fb1c8f2c8297d629b2292d

diff --git a/rkward/rbackend/rpackages/rkward/R/rk.KDE_GUI-functions.R b/rkward/rbackend/rpackages/rkward/R/rk.KDE_GUI-functions.R
index f7d8f807..771abc0d 100644
--- a/rkward/rbackend/rpackages/rkward/R/rk.KDE_GUI-functions.R
+++ b/rkward/rbackend/rpackages/rkward/R/rk.KDE_GUI-functions.R
@@ -27,6 +27,9 @@
 #' @param button.cancel a string used for the text label of the \bold{Cancel} button.
 #'   This behaves similar to \code{button.yes}, including the meaning of the
 #'   default value "cancel".
+#' @param prompts either a character vector containing 3 prompts corresponding to return
+#'   values of TRUE, FALSE, or NA, or a single character value containing the prompts
+#'   separated by \code{/} characters.
 #' @param default The expected or "safe" default response (e.g. \code{TRUE} for "Yes button").
 #'   The corresponding button will focused, so that it will become selected option,
 #'   if the user simply presses enter.
@@ -77,6 +80,7 @@
 #' @export
 #' @rdname rk.show.messages
 "rk.show.question" <- function (message, caption = gettext("Question"), button.yes = "yes", button.no = "no", button.cancel = "cancel", default=TRUE) {
+  .Deprecated("rk.askYesNo")
 	if (isTRUE (default)) default_button <- button.yes
 	else if (identical (default, FALSE)) default_button <- button.no
 	else default_button <- button.cancel
@@ -86,6 +90,51 @@
 	else return (NULL)	# cancelled
 }
 
+#' @export
+#' @rdname rk.show.messages
+"rk.askYesNo" <- function (message, default = TRUE, prompts = c("yes", "no", "cancel"), caption = gettext("Question")) {
+  if(is.character(prompts)){
+    if(length(prompts) == 1){
+      prompts <- unlist(strsplit(prompts, "/"))
+    } else {}
+    if(length(prompts) != 3){
+      stop(simpleError("'prompts' must be either a single character string or three character values!"))
+    } else {}
+    button.yes <- prompts[1]
+    button.no <- prompts[2]
+    button.cancel <- prompts[3]
+  } else {
+    stop(simpleError("'prompts' must be character!"))
+  }
+
+  default_button <- switch(
+    as.character(as.logical(default)),
+    "TRUE"=button.yes,
+    "FALSE"=button.no,
+    button.cancel
+  )
+
+  res <- .Call(
+    "rk.dialog",
+    caption,
+    message,
+    button.yes,
+    button.no,
+    button.cancel,
+    default_button,
+    TRUE,
+    PACKAGE="(embedding)"
+  )
+
+  if (res > 0){
+    return (TRUE)
+  } else if (res < 0){
+    return (FALSE)
+  } else {
+    return (NA) # cancelled
+  }
+}
+
 # drop-in-replacement for tk_select.list()
 #' @export
 #' @rdname rk.show.messages