public
Last active

Function to create a tcl/tk dialog box for a user to enter variable values.

  • Download Gist
varEntryDialog.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
#' Creates a dialog box using tcl/tk to get input from the user.
#'
#' This function will create a tcl/tk dialog box to get user input. It has been
#' written to be extensible so the R programmer can easily create a dialog with
#' any number of varaibles with custom labels and data conversion of the user
#' entered data. The function will return a list where the element names are
#' \code{vars} and the value is the user input. By default, all entry will be
#' converted using the \code{as.character} function. However, this can easily be
#' altered using the \code{fun} parameter. For example, if integers are required,
#' use \code{fun=c(as.integer, ...)}. It is also possible to write custom
#' functions that can serve as a data validation. See the examples.
#'
#' Adopted from Kay Cichini:
#' \url{http://thebiobucket.blogspot.com/2012/08/tcltk-gui-example-with-variable-input.html}
#' See also:
#' \url{http://bioinf.wehi.edu.au/~wettenhall/RTclTkExamples/OKCancelDialog.html}
#'
#' @param vars character list of variable names. These will be the element names
#' within the returned list.
#' @param labels the labels the user will see for each variable entry.
#' @param fun list of functions that converts the user input.
#' @param title the title of the dialog box.
#' @param prompt the prompt the user will see on the dialog box.
#' @return a \code{\link{list}} of named values entered by the user.
varEntryDialog <- function(vars,
labels = vars,
fun = rep(list(as.character), length(vars)),
title = 'Variable Entry',
prompt = NULL) {
require(tcltk)
stopifnot(length(vars) == length(labels), length(labels) == length(fun))
 
# Create a variable to keep track of the state of the dialog window:
# done = 0; If the window is active
# done = 1; If the window has been closed using the OK button
# done = 2; If the window has been closed using the Cancel button or destroyed
done <- tclVar(0)
 
tt <- tktoplevel()
tkwm.title(tt, title)
entries <- list()
tclvars <- list()
 
# Capture the event "Destroy" (e.g. Alt-F4 in Windows) and when this happens,
# assign 2 to done.
tkbind(tt,"<Destroy>",function() tclvalue(done)<-2)
for(i in seq_along(vars)) {
tclvars[[i]] <- tclVar("")
entries[[i]] <- tkentry(tt, textvariable=tclvars[[i]])
}
doneVal <- as.integer(tclvalue(done))
results <- list()
 
reset <- function() {
for(i in seq_along(entries)) {
tclvalue(tclvars[[i]]) <<- ""
}
}
reset.but <- tkbutton(tt, text="Reset", command=reset)
cancel <- function() {
tclvalue(done) <- 2
}
cancel.but <- tkbutton(tt, text='Cancel', command=cancel)
submit <- function() {
for(i in seq_along(vars)) {
tryCatch( {
results[[vars[[i]]]] <<- fun[[i]](tclvalue(tclvars[[i]]))
tclvalue(done) <- 1
},
error = function(e) { tkmessageBox(message=geterrmessage()) },
finally = { }
)
}
}
submit.but <- tkbutton(tt, text="Submit", command=submit)
if(!is.null(prompt)) {
tkgrid(tklabel(tt,text=prompt), columnspan=3, pady=10)
}
for(i in seq_along(vars)) {
tkgrid(tklabel(tt, text=labels[i]), entries[[i]], pady=10, padx=10, columnspan=4)
}
tkgrid(submit.but, cancel.but, reset.but, pady=10, padx=10, columnspan=3)
tkfocus(tt)
 
# Do not proceed with the following code until the variable done is non-zero.
# (But other processes can still run, i.e. the system is not frozen.)
tkwait.variable(done)
if(tclvalue(done) != 1) {
results <- NULL
}
tkdestroy(tt)
return(results)
}
 
if(FALSE) { #Test the dialog
vals <- varEntryDialog(vars=c('Variable1', 'Variable2'))
str(vals)
vals <- varEntryDialog(vars=c('Var1', 'Var2'),
labels=c('Enter an integer:', 'Enter a string:'),
fun=c(as.integer, as.character))
str(vals)
#Add a custom validation function
vals <- varEntryDialog(vars=c('Var1'),
labels=c('Enter an integer between 0 and 10:'),
fun=c(function(x) {
x <- as.integer(x)
if(x >= 0 & x <= 10) {
return(x)
} else {
stop("Why didn't you follow instruction!\nPlease enter a number between 0 and 10.")
}
} ))
str(vals)
#Return a list
vals <- varEntryDialog(vars=c('Var1'),
labels=c('Enter a comma separated list of something:'),
fun=c(function(x) {
return(strsplit(x, split=','))
}))
vals$Var1
str(vals)
}

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.