#' @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 #' @export 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) }