R/questdlg.R

In matlab2r: Translation Layer from MATLAB to R

#' @title Prompt for multiple-choice
#' @param quest Question
#' @param dlgtitle Title of question
#' @param btn Vector of alternatives
#' @param defbtn Scalar with the name of the default option
#' @param accepted_ans Vector containing accepted answers
#' @description This function aims to loosely mimic the behavior of the
#' questdlg function on Matlab
#' @return Whatever is entered by the user after the prompt created by the
#' function.
#' @export
#' @examples
#' \dontrun{
#'   ans <- questdlg("Do you want to continue?", "Continue?")
#'   if (tolower(substring(ans, 1, 1)) == "y") {
#'     message("You typed yes")
#'   } else {
#'     message("You didn't type yes")
#'   }
#' }
questdlg <- function(
  quest, dlgtitle = "", btn = c("y", "n"), defbtn = "n",
  accepted_ans = c("y", "yes", "n", "no")
) {
  message(dlgtitle)
  # ==========================================================================
  # Replacing the default option with a capitalized version on btn
  # ==========================================================================
  btn[match(tolower(defbtn), tolower(btn))] <- toupper(defbtn)
  # ==========================================================================
  # Creating prompt
  # ==========================================================================
  option_char <- paste0(" [", paste(btn, collapse = ", "), "]")
  answer <- readline(paste0(quest, option_char, ": "))
  # ==========================================================================
  # Processing answer
  # ==========================================================================
  answer <- tolower(answer)
  if (!(answer %in% tolower(c(btn, accepted_ans)))) {
    if (answer != "") {
      warning(
        "'", answer, "' is not a valid alternative. Defaulting to ",
        defbtn
      )
    }
    answer <- defbtn
  }
  return(answer)
}