Added accepted_ans arg to improve answer handling

This commit is contained in:
Waldir Leoncio 2020-05-20 11:34:26 +02:00
parent 3f8121f5a6
commit ce7fdeb003
2 changed files with 19 additions and 4 deletions

View file

@ -3,10 +3,17 @@
#' @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') {
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
@ -21,10 +28,10 @@ questdlg <- function(quest, dlgtitle, btn = c('y', 'n'), defbtn = 'n') {
# Processing answer
# ==========================================================================
answer <- tolower(answer)
if (!(answer %in% tolower(c(btn)))) {
if (!(answer %in% tolower(c(btn, accepted_ans)))) {
if (answer != "") {
warning(
"'", answer, "' is not a valid altenative. Defaulting to ",
"'", answer, "' is not a valid alternative. Defaulting to ",
defbtn
)
}