R/data-menu.R

In Rcmdr: R Commander

# Data menu dialogs

newDataSet <- function() {
    initializeDialog(title=gettextRcmdr("New Data Set"))
    dsname <- tclVar("Dataset")
    entryDsname <- ttkentry(top, width="20", textvariable=dsname)
    onOK <- function(){
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=newDataSet,
                           message=gettextRcmdr("You must enter the name of a data set."))
            return()
        }
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=newDataSet,
                           message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                newDataSet()
                return()
            }
        }
        closeDialog()
        command <- paste("editDataset(dsname='", dsnameValue, "')", sep="")
        result <- justDoIt(command)
        if (class(result)[1] !=  "try-error"){
            if (!getRcmdr("dataset.modified")) return()
            .data <- try(get(dsnameValue, envir=.GlobalEnv), silent=TRUE)
            if (nrow(.data) == 0){
                errorCondition(recall=newDataSet, message=gettextRcmdr("empty data set."))
                return()
            }
            tempdir <- tempdir()
            tempdir <- gsub("\\\\", "/", tempdir)
            savefile <- paste(tempdir, "/", dsnameValue, sep="")
            save(".data", file=savefile)
            if (getRcmdr("use.markdown")) {
                removeNullRmdBlocks()
                enterMarkdown(paste('load("', savefile, '")', sep=""))
            }
            if (getRcmdr("use.knitr")) {
                removeNullRnwBlocks()
                enterKnitr(paste('load("', savefile, '")', sep=""))
            }
       }
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="editDataset")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="e")
    tkgrid(buttonsFrame, columnspan="2", sticky="w")
    tkgrid.configure(entryDsname, sticky="w")
    dialogSuffix(focus=entryDsname)
}

selectActiveDataSet <- function(){
	dataSets <- listDataSets()
	.activeDataSet <- ActiveDataSet()
	if ((length(dataSets) == 1) && !is.null(.activeDataSet)) {
		Message(message=gettextRcmdr("There is only one dataset in memory."),
				type="warning")
		tkfocus(CommanderWindow())
		return()
	}
	if (length(dataSets) == 0){
		Message(message=gettextRcmdr("There are no data sets from which to choose."),
				type="error")
		tkfocus(CommanderWindow())
		return()
	}
	initializeDialog(title=gettextRcmdr("Select Data Set"))
	dataSetsBox <- variableListBox(top, dataSets, title=gettextRcmdr("Data Sets (pick one)"),
			initialSelection=if (is.null(.activeDataSet)) NULL else which(.activeDataSet == dataSets) - 1)
	onOK <- function(){
		selection <- getSelection(dataSetsBox)
		closeDialog()
		setBusyCursor()
		on.exit(setIdleCursor())
		activeDataSet(selection)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp()
	tkgrid(getFrame(dataSetsBox), sticky="nw")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix()
}

listDataSetsInPackages <- function() doItAndPrint("data()")

#' @title Rcmdr Recode Dialog
#'
#' @keywords manip
#' 
#' @details
#' Recode numeric variables and factors into factors.
#' 
#' The recode dialog is normally used to recode numeric variables and factors into factors, for example by combining values of numeric variables or levels of factors.
#' It may also be used to produce new numeric variables.
#' The Rcmdr recode dialog is based on the \code{\link[car:recode]{Recode}} function in the \pkg{car} package.
#'
#' The name of each new variable must be a valid R object name (consisting only of upper and lower-case letters, numerals, and periods, and not starting with a numeral).
#'
#' Enter recode directives in the box near the bottom of the dialog.
#' Directives are normally entered one per line, but may also be separated by semicolons.
#' Each directive is of the form \code{input = output} (see the examples below).
#' If an input value satisfies more than one specification, then the first (from top to bottom, and left to right) applies.
#' If no specification is satisfied, then the input value is carried over to the result.
#' \code{NA} is allowed on input and output.
#' Factor levels are enclosed in double-quotes on both input and output.
#'
#' Several recode specifications are supported:
#' \describe{
#'    \item{a single value}{For example, \code{"missing" = NA}.}
#'    \item{several values separated by commas}{For example, \code{7,8,9 = "high"}.}
#'    \item{a range of values indicated by a colon}{For example, \code{7:9 = "high"}.
#'       The special values \code{lo} and \code{hi} may appear in a range.
#'       For example, \code{lo:10=1}.
#'       Note that these values are unquoted.}
#'    \item{the special value \code{else}}{everything that does not fit a previous specification.
#'       For example, \code{else=NA}.
#'       Note that \code{else} matches \emph{all} otherwise unspecified values on input, including \code{NA}.}
#' }
#'
#' If all of the output values are numeric, and the "Make new variable a factor" check box is unchecked, then a numeric result is returned.
#'
#' If several variables are selected for recoding, then each is recoded using the same recode directives.
#' In this case, the name entered in the box labelled "New variable name or prefix for multiple recodes" will be prefixed to the name of each variable being recoded.
#' Setting an empty prefix (i.e., "") will cause the recoded variables to replace the original variables.
#'
#' As explained, \code{=} is used to separate old from new values, and \code{:} is used to specify an interval (or range) of numeric values.
#' It is possible to change these operators to other character strings, such as \code{->} and \code{~} (tilde).
#' This may be necessary, for example, if a factor to be recoded has \code{=}s or \code{:}s in its level (category) names.
#'
#' Similarly, the dialog generates a call to the \code{\link[car]{Recode}} function in the \pkg{car} package, which by default uses \code{;} to separate recode specifications.
#' The recode separator can also be changed, for example, to \code{/}.
#'
#' @author John Fox
#'
#' @seealso \code{\link[car]{Recode}}
#'
#' @export
RecodeDialog <- function () {
  processRecode <- function(recode) {
    parts <- strsplit(recode, "=")[[1]]
    if (length(grep(",", parts[1])) > 0) 
      paste("c(", parts[1], ") = ", parts[2], sep = "")
    else paste(parts, collapse = "=")
  }
  dataSet <- activeDataSet()
  defaults <- list (initial.asFactor = 1, initial.variables = NULL, initial.name = "variable",
                    initial.recode.directives="", 
                    initial.to.value="=", initial.interval=":", initial.separator=";")
  dialog.values <- getDialog ("RecodeDialog", defaults)
  initializeDialog(title = gettextRcmdr("Recode Variables"))
  variablesBox <- variableListBox(top, Variables(), selectmode = "multiple", 
                                  title = gettextRcmdr("Variables to recode (pick one or more)"),
                                  initialSelection = varPosn (dialog.values$initial.variables, "all"))
  variablesFrame <- tkframe(top)
  newVariableName <- tclVar(dialog.values$initial.name)
  newVariable <- ttkentry(variablesFrame, width = "20", textvariable = newVariableName)
  recodesFrame <- tkframe(top)
  recodes <- tktext(recodesFrame, bg = "white", font = getRcmdr("logFont"), 
                    height = "5", width = "40", wrap = "none")
  recodesXscroll <- ttkscrollbar(recodesFrame, orient = "horizontal", 
                                 command = function(...) tkxview(recodes, ...))
  recodesYscroll <- ttkscrollbar(recodesFrame, command = function(...) tkyview(recodes, 
                                                                               ...))
  tkconfigure(recodes, xscrollcommand = function(...) tkset(recodesXscroll, 
                                                            ...))
  tkconfigure(recodes, yscrollcommand = function(...) tkset(recodesYscroll, 
                                                            ...))
  tkinsert(recodes, "1.0", dialog.values$initial.recode.directives)
  asFactorFrame <- tkframe(top)
  asFactorVariable <- tclVar(dialog.values$initial.asFactor)
  asFactorCheckBox <- ttkcheckbutton(asFactorFrame, variable = asFactorVariable)
  operatorsFrame <- tkframe(top)
  to.valueVariable <- tclVar(dialog.values$initial.to.value)
  to.valueBox <- ttkentry(operatorsFrame, width = "3", textvariable = to.valueVariable)
  intervalVariable <- tclVar(dialog.values$initial.interval)
  intervalBox <- ttkentry(operatorsFrame, width = "3", textvariable = intervalVariable)
  separatorVariable <- tclVar(dialog.values$initial.separator)
  separatorBox <- ttkentry(operatorsFrame, width = "3", textvariable = separatorVariable)
  onOK <- function() {
    asFactor <- tclvalue(asFactorVariable) == "1"
    to.value <- tclvalue(to.valueVariable)
    interval <- tclvalue(intervalVariable)
    separator <- tclvalue(separatorVariable)
    save.recodes <- trim.blanks(tclvalue(tkget(recodes, "1.0", "end")))
    recode.directives <- gsub("\n", paste0(separator, " "), save.recodes)
    check.empty <- gsub(separator, "", gsub(" ", "", recode.directives))
    if ("" == check.empty) {
      errorCondition(recall = RecodeDialog, message = gettextRcmdr("No recode directives specified."))
      return()
    }
    if (0 != length(grep("'", recode.directives))) {
      errorCondition(recall = RecodeDialog, message = gettextRcmdr("Use only double-quotes (\" \") in recode directives"))
      return()
    }
    recode.directives <- strsplit(recode.directives, separator)[[1]]
    recode.directives <- paste(sapply(recode.directives, 
                                      processRecode), collapse = separator)
    recode.directives <- sub(paste0(" *", separator, " *$"), "", recode.directives)
    variables <- getSelection(variablesBox)
    closeDialog()
    if (length(variables) == 0) {
      errorCondition(recall = RecodeDialog, message = gettextRcmdr("You must select a variable."))
      return()
    }
    multiple <- if (length(variables) > 1) 
      TRUE
    else FALSE
    name <- trim.blanks(tclvalue(newVariableName))
    putDialog ("RecodeDialog", list (initial.asFactor = asFactor, initial.variables = variables,
                                     initial.name = name, initial.recode.directives=save.recodes,
                                     initial.to.value=to.value, initial.interval=interval,
                                     initial.separator=separator))
    command <- paste(dataSet, " <- within(", dataSet, ", {", sep="")
    nvar <- length(variables)
    for (i in 1:nvar) {
      variable <- variables[nvar - i + 1]
      newVar <- if (multiple) 
        paste(name, variable, sep = "")
      else name
      if (!is.valid.name(newVar)) {
        errorCondition(recall = RecodeDialog, message = paste("\"", 
                                                              newVar, "\" ", gettextRcmdr("is not a valid name."), 
                                                              sep = ""))
        return()
      }
      if (is.element(newVar, Variables())) {
        if ("no" == tclvalue(checkReplace(newVar))) {
          RecodeDialog()
          return()
        }
      }
      command <- paste(command, "\n  ", newVar, " <- Recode(", variable, ", '", 
                       recode.directives, "', as.factor=", asFactor, 
                       ', to.value="', to.value, '", interval="', interval, 
                       '", separator="', separator, '")', sep = "")  
    }
    command <- paste(command, "\n})", sep="")
    result <- doItAndPrint(command)
    if (class(result)[1] != "try-error")
      activeDataSet(dataSet, flushModel = FALSE, flushDialogMemory = FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject = "RecodeDialog", reset = "RecodeDialog", apply = "RecodeDialog")
  tkgrid(getFrame(variablesBox), sticky = "nw")
  tkgrid(labelRcmdr(variablesFrame, text = ""))
  tkgrid(labelRcmdr(variablesFrame, text = gettextRcmdr("New variable name or prefix for multiple recodes: ")), 
         newVariable, sticky = "w")
  tkgrid(asFactorCheckBox, labelRcmdr(asFactorFrame, text = gettextRcmdr("Make (each) new variable a factor")), 
         sticky = "w")
  tkgrid(labelRcmdr(operatorsFrame, text = gettextRcmdr("Old/new values assignment character(s)  ")),
         to.valueBox, sticky="w")
  tkgrid(labelRcmdr(operatorsFrame, text = gettextRcmdr("Recode interval character(s)  ")),
         intervalBox, sticky="w")
  tkgrid(labelRcmdr(operatorsFrame, text = gettextRcmdr("Recode separator character(s)  ")),
         separatorBox, sticky="w")
  tkgrid(labelRcmdr(operatorsFrame, text = ""))
  tkgrid(labelRcmdr(recodesFrame, text = gettextRcmdr("Enter recode directives"), 
                    fg = getRcmdr("title.color"), font="RcmdrTitleFont"), sticky = "w")
  tkgrid(recodes, recodesYscroll, sticky = "nw")
  tkgrid(recodesXscroll)
  tkgrid(variablesFrame, sticky = "w")
  tkgrid(asFactorFrame, sticky = "w")
  tkgrid(operatorsFrame, sticky = "w")
  tkgrid(recodesFrame, sticky = "w")
  tkgrid(buttonsFrame, sticky = "w", columnspan = 2)
  tkgrid.configure(recodesXscroll, sticky = "ew")
  tkgrid.configure(recodesYscroll, sticky = "ns")
  dialogSuffix(bindReturn = FALSE)
}

#' @title Rcmdr Compute Dialog
#'
#' @keywords manip
#' 
#' @details
#' The compute dialog is used to compute new variables.
#'
#' The name of the new variable must be a valid R object name (consisting only of upper and lower-case letters, numerals, and periods, and not starting with a numeral).
#'
#' Enter an R expression in the box at the right.
#' The expression is evaluated using the active data set.
#' You can double-click in the variable-list box to enter variable names in the expression.
#' The expression must evaluate to a valid variable, which is added to the active data set.
#'
#' @author John Fox
#' 
#' @usage NULL
#'
#' @seealso \code{\link[base]{Arithmetic}}
Compute <- function(){
    onDoubleClick <-function(){
        var <- trim.blanks(getSelection(variablesBox))
        word <- paste("\\[", gettextRcmdr("factor"), "\\]", sep="")
        if (length(grep(word, var)) == 1)
            var <- trim.blanks(sub(word, "",  var))
        tkfocus(compute)
        expr <- tclvalue(computeVar)
        tclvalue(computeVar) <- if (expr == "") var
        else paste(expr, var, sep=if (rev(strsplit(expr, "")[[1]])[1] =="(" ) "" else " ")
        tkicursor(compute, "end")
        tkxview.moveto(compute, "1")
    }
    defaults <- list(initial.name = "variable", initial.expression = "")
    dialog.values <- getDialog("Compute", defaults)
    dataSet <- activeDataSet()
    initializeDialog(title=gettextRcmdr("Compute New Variable"))
    .variables <- Variables()
    variables <- paste(.variables, ifelse(is.element(.variables, Factors()), gettextRcmdr("[factor]"), ""))
    variablesBox <- variableListBox(top, variables, title=gettextRcmdr("Current variables (double-click to expression)"))
    tkbind(variablesBox$listbox, "<Double-ButtonPress-1>", onDoubleClick)
    variablesFrame <- tkframe(top)
    newVariableName <- tclVar(dialog.values$initial.name)
    newVariable <- ttkentry(variablesFrame, width="20", textvariable=newVariableName)
    computeFrame <- tkframe(top)
    computeVar <- tclVar(dialog.values$initial.expression)
    compute <- ttkentry(computeFrame, font=getRcmdr("logFont"), width="30", textvariable=computeVar)
    computeXscroll <- ttkscrollbar(computeFrame,
                                   orient="horizontal", command=function(...) tkxview(compute, ...))
    tkconfigure(compute, xscrollcommand=function(...) tkset(computeXscroll, ...))
    onOK <- function(){
        closeDialog()
        newVar <- trim.blanks(tclvalue(newVariableName))
        if (!is.valid.name(newVar)){
            errorCondition(recall=Compute,
                           message=paste('"', newVar, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        express <- tclvalue(computeVar)
        check.empty <- gsub(";", "", gsub(" ", "", express))
        if ("" == check.empty) {
            errorCondition(recall=Compute,
                           message=gettextRcmdr("No expression specified."))
            return()
        }
        putDialog("Compute", list(initial.name=newVar, initial.expression=express))
        if (is.element(newVar, Variables())) {
            if ("no" == tclvalue(checkReplace(newVar, gettextRcmdr("Variable")))){
                Compute()
                return()
            }
        }
        command <-  paste(dataSet,"$",newVar, " <- with(", ActiveDataSet(),
                          ", ", express, ")", sep="")
        logger(command)
        result <- justDoIt(command)
        if (class(result)[1] !=  "try-error") activeDataSet(dataSet, flushModel=FALSE, flushDialogMemory=FALSE)
        else{
            if (getRcmdr("use.markdown")) removeLastRmdBlock()
            if (getRcmdr("use.knitr")) removeLastRnwBlock()
        }
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="Compute", reset = "Compute", apply = "Compute")
    tkgrid(getFrame(variablesBox), sticky="nw", columnspan=2)
    tkgrid(labelRcmdr(variablesFrame, text=gettextRcmdr("New variable name")), sticky="w")
    tkgrid(newVariable, labelRcmdr(variablesFrame, text="     "), sticky="w")
    tkgrid(labelRcmdr(computeFrame, text=gettextRcmdr("Expression to compute")), sticky="w")
    tkgrid(compute, sticky="w")
    tkgrid(computeXscroll, sticky="ew")
    tkgrid(variablesFrame, computeFrame, sticky="nw")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    dialogSuffix(focus=compute)
}

deleteVariable <- function(){
  dataSet <- activeDataSet()
  initializeDialog(title=gettextRcmdr("Delete Variables"))
  variablesBox <- variableListBox(top, Variables(),
                                  title=gettextRcmdr("Variable(s) to delete (pick one or more)"), selectmode="multiple",
                                  initialSelection=NULL)
  onOK <- function(){
    variables <- getSelection(variablesBox)
    closeDialog()
    if (length(variables) == 0) {
      errorCondition(recall=deleteVariable, message=gettextRcmdr("You must select one or more variables."))
      return()
    }
    if (length(variables) == 1){
      response <- tclvalue(RcmdrTkmessageBox(message=sprintf(gettextRcmdr("Delete %s?\nPlease confirm."), variables), icon="warning", type="okcancel", default="cancel"))
      if (response == "cancel") {
        onCancel()
        return()
      }
    }
    else{
      response <- tclvalue(RcmdrTkmessageBox(message=
                                               sprintf(gettextRcmdr("Delete %d variables?\nPlease confirm."), length(variables)),
                                             icon="warning", type="okcancel", default="cancel"))
      if (response == "cancel") {
        onCancel()
        return()
      }
    }
    command <- paste(dataSet, " <- within(", dataSet, ", {", sep="")
    for (variable in variables){
      command <- paste(command, "\n  ", variable, " <- NULL", sep="")
    }
    command <- paste(command, "\n})")
    doItAndPrint(command)
    activeDataSet(dataSet, flushModel=FALSE, flushDialogMemory=FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="NULL")
  tkgrid(getFrame(variablesBox), sticky="nw")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix()
}

readDataSet <- function() {
    initializeDialog(title=gettextRcmdr("Read Text Data From File, Clipboard, or URL"))
    optionsFrame <- tkframe(top)
    dsname <- tclVar("Dataset")
    entryDsname <- ttkentry(optionsFrame, width="20", textvariable=dsname)
    radioButtons(optionsFrame, "location", buttons=c("local", "clipboard", "url"), 
                 labels=gettextRcmdr(c("Local file system", "Clipboard", "Internet URL")), title=gettextRcmdr("Location of Data File"))
    headerVariable <- tclVar("1")
    headerCheckBox <- ttkcheckbutton(optionsFrame, variable=headerVariable)
    stringsAsFactorsVariable <- tclVar("1")
    stringsAsFactorsCheckBox <- ttkcheckbutton(optionsFrame, variable=stringsAsFactorsVariable)
    radioButtons(optionsFrame, "delimiter", buttons=c("whitespace", "commas", "semicolons", "tabs"),
                 labels=gettextRcmdr(c("White space", "Commas [,]", "Semicolons [;]", "Tabs")), title=gettextRcmdr("Field Separator"),
                 columns=2) 
    otherDelimiterFrame <- tkframe(optionsFrame)
    otherButton <- ttkradiobutton(otherDelimiterFrame, variable=delimiterVariable, value="other", text=gettextRcmdr("Other"))
    otherVariable <- tclVar("")
    otherEntry <- ttkentry(otherDelimiterFrame, width="4", textvariable=otherVariable)
    radioButtons(optionsFrame, "decimal", buttons=c("period", "comma"),
                 labels=gettextRcmdr(c("Period [.]", "Comma [,]")), title=gettextRcmdr("Decimal-Point Character"))
    missingVariable <- tclVar("NA")
    missingEntry <- ttkentry(optionsFrame, width="8", textvariable=missingVariable)
    onOK <- function(){
        closeDialog()
        setBusyCursor()
        on.exit(setIdleCursor())
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == ""){
            errorCondition(recall=readDataSet,
                           message=gettextRcmdr("You must enter a name for the data set."))
            return()
        }
        if (!is.valid.name(dsnameValue)){
            errorCondition(recall=readDataSet,
                           message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                readDataSet()
                return()
            }
        }
        location <- tclvalue(locationVariable)
        file <- if (location == "clipboard") {
            if (MacOSXP()) 'pipe("pbpaste")' else "clipboard" 
        }
        else if (location == "local") tclvalue(tkgetOpenFile(filetypes=
                                                                 gettextRcmdr('{"All Files" {"*"}} {"Text Files" {".txt" ".TXT" ".dat" ".DAT" ".csv" ".CSV"}}')))
        else {
            initializeDialog(subdialog, title=gettextRcmdr("Internet URL"))
            onOKsub <- function(){
                closeDialog(subdialog)
            }
            urlFrame <- tkframe(subdialog)
            urlVar <- tclVar("")
            url <- ttkentry(urlFrame, font=getRcmdr("logFont"), width="30", textvariable=urlVar)
            urlXscroll <- ttkscrollbar(urlFrame,
                                       orient="horizontal", command=function(...) tkxview(url, ...))
            tkconfigure(url, xscrollcommand=function(...) tkset(urlXscroll, ...))
            .subexit <- function() tclvalue(urlVar) <- ""
            subOKCancelHelp()
            tkgrid(url, sticky="w")
            tkgrid(urlXscroll, sticky="ew")
            tkgrid(urlFrame, sticky="nw")
            tkgrid(subButtonsFrame, sticky="w")
            dialogSuffix(subdialog, focus=url, onOK=onOKsub, force.wait=TRUE)
            tclvalue(urlVar)
        }
        if (file == "") {
            if (getRcmdr("grab.focus")) tkgrab.release(top)
            tkdestroy(top)
            return()
        }
        head <- tclvalue(headerVariable) == "1"
        stringsAsFactors <- tclvalue(stringsAsFactorsVariable) == "1"
        delimiter <- tclvalue(delimiterVariable)
        del <- if (delimiter == "whitespace") ""
        else if (delimiter == "commas") ","
        else if (delimiter == "semicolons") ";"
        else if (delimiter == "tabs") "\\t"
        else tclvalue(otherVariable)
        miss <- tclvalue(missingVariable)
        dec <- if (tclvalue(decimalVariable) == "period") "." else ","
        if (!(location == "clipboard" && MacOSXP())) file <- paste0('"', file, '"')
        command <- paste("read.table(", file, ", header=", head,
                         ', stringsAsFactors=', stringsAsFactors,
                         ', sep="', del, '", na.strings="', miss, '", dec="', dec, '", strip.white=TRUE)', sep="")
        logger(paste(dsnameValue, " <- ", command, sep=""))
        result <- justDoIt(command)
        if (class(result)[1] !=  "try-error"){
            gassign(dsnameValue, result)
            activeDataSet(dsnameValue)
        }
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="read.table")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Variable names in file:")), headerCheckBox, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Convert character variables to factors")), stringsAsFactorsCheckBox, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Missing data indicator:")), missingEntry, sticky="w")
    tkgrid(locationFrame, sticky="w")
    tkgrid(otherButton, 
           labelRcmdr(otherDelimiterFrame, text=gettextRcmdr("    Specify:")), otherEntry, sticky="ew", padx="3")
    tkgrid(delimiterFrame, sticky="nw", columnspan=2)
    tkgrid(otherDelimiterFrame, sticky="w")
    tkgrid(decimalFrame, sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix()
}

#' @title Read data from package
#'
#' @usage NULL
#' 
#' @details
#'
#' This menu option can be used to load data sets provided by currently attached packages.
#' 
#' Selecting the menu items \code{Data} -> \code{Data in packages} -> \code{Read data set from an attached package...} opens a new dialog window.
#'
#' Double-clicking an item in the left list box displays the available data sets for the selected package in the right list box.
#' Once a data set is selected, clicking \code{OK} loads and activates it.
#'
#' Additionally, documentation for a selected data set can be accessed by clicking the \code{Help on selected data set} button.
#'
#' If the name of the data set is already known, it can be entered directly into the "Enter name of data set:" field.
#' Note that this field is only available before a package has been selected from the list.
#'
#' For example, double-clicking \code{carData} in the left list, selecting \code{Chile} in the right list, and clicking \code{OK} will load and activate the \code{Chile} data set from the \pkg{carData} package.
#' 
#' This menu option calls the \code{\link[utils]{data}} function from the \code{\link[utils]{utils-package}} package.
#' 
readDataFromPackage <- function() {
	env <- environment()
	datasets <- NULL
	initializeDialog(title=gettextRcmdr("Read Data From Package"))
	dsname <- tclVar("")
	package <- NULL
	enterFrame <- tkframe(top)
	entryDsname <- ttkentry(enterFrame, width="20", textvariable=dsname)
	packages <- sort(.packages())
	packages <- packages[! packages %in% c("base", "stats")]
	packages <- packages[sapply(packages, function(package){
						ds <- utils::data(package=package)$results
						if (nrow(ds) == 0) return(FALSE)
						ds <- ds[, "Item"]
						# ds <- trim.blanks(sub("\\(.*\\)", "", ds))
						valid <- sapply(ds, is.valid.name)
						length(ds[valid]) > 0
					})]
	packageDatasetFrame <- tkframe(top)
	packageFrame <- tkframe(packageDatasetFrame)
	max.height <- getRcmdr("variable.list.height")
	packageBox <- tklistbox(packageFrame, height=min(max.height, length(packages)), 
            exportselection="FALSE",
			selectmode="single", background="white")
	packageScroll <- ttkscrollbar(packageFrame,
			command=function(...) tkyview(packageBox, ...))
	tkconfigure(packageBox, yscrollcommand=function(...) tkset(packageScroll, ...))
	for (p in packages) tkinsert(packageBox, "end", p)
	datasetFrame <- tkframe(packageDatasetFrame)
	datasetBox <- tklistbox(datasetFrame, height=max.height, exportselection="FALSE",
			selectmode="single", background="white")
	datasetScroll <- ttkscrollbar(datasetFrame,
			command=function(...) tkyview(datasetBox, ...))
	tkconfigure(datasetBox, yscrollcommand=function(...) tkset(datasetScroll, ...))
	onPackageSelect <- function(){
		assign("package", packages[as.numeric(tkcurselection(packageBox)) + 1], envir=env)
		datasets <<- utils::data(package=package)$results[,3]
		valid <- sapply(datasets, is.valid.name)
		datasets <<- datasets[valid]
		tkdelete(datasetBox, "0", "end")
		for (dataset in datasets) tkinsert(datasetBox, "end", dataset)
		tkconfigure(datasetBox, height=min(max.height, length(datasets)))
		firstChar <- tolower(substr(datasets, 1, 1))
		len <- length(datasets)
		onLetter <- function(letter){
			letter <- tolower(letter)
			current <- 1 + round(as.numeric(unlist(strsplit(tclvalue(tkyview(datasetBox) ), " "))[1])*len)
			mat <- match(letter, firstChar[-(1:current)])
			if (is.na(mat)) return()
			tkyview.scroll(datasetBox, mat, "units")
		}
		onA <- function() onLetter("a")
		onB <- function() onLetter("b")
		onC <- function() onLetter("c")
		onD <- function() onLetter("d")
		onE <- function() onLetter("e")
		onF <- function() onLetter("f")
		onG <- function() onLetter("g")
		onH <- function() onLetter("h")
		onI <- function() onLetter("i")
		onJ <- function() onLetter("j")
		onK <- function() onLetter("k")
		onL <- function() onLetter("l")
		onM <- function() onLetter("m")
		onN <- function() onLetter("n")
		onO <- function() onLetter("o")
		onP <- function() onLetter("p")
		onQ <- function() onLetter("q")
		onR <- function() onLetter("r")
		onS <- function() onLetter("s")
		onT <- function() onLetter("t")
		onU <- function() onLetter("u")
		onV <- function() onLetter("v")
		onW <- function() onLetter("w")
		onX <- function() onLetter("x")
		onY <- function() onLetter("y")
		onZ <- function() onLetter("z")
		for (letter in c(letters, LETTERS)){
			tkbind(datasetBox, paste("<", letter, ">", sep=""),
					get(paste("on", toupper(letter), sep="")))
		}
		onClick <- function() tkfocus(datasetBox)
		tkbind(datasetBox, "<ButtonPress-1>", onClick)
	}
	onDatasetSelect <- function(){
		tclvalue(dsname) <- datasets[as.numeric(tkcurselection(datasetBox)) + 1]
	}
	firstChar <- tolower(substr(packages, 1, 1))
	len <- length(packages)
	onLetter <- function(letter){
		letter <- tolower(letter)
		current <- 1 + round(as.numeric(unlist(strsplit(tclvalue(tkyview(packageBox) ), " "))[1])*len)
		mat <- match(letter, firstChar[-(1:current)])
		if (is.na(mat)) return()
		tkyview.scroll(packageBox, mat, "units")
	}
	onA <- function() onLetter("a")
	onB <- function() onLetter("b")
	onC <- function() onLetter("c")
	onD <- function() onLetter("d")
	onE <- function() onLetter("e")
	onF <- function() onLetter("f")
	onG <- function() onLetter("g")
	onH <- function() onLetter("h")
	onI <- function() onLetter("i")
	onJ <- function() onLetter("j")
	onK <- function() onLetter("k")
	onL <- function() onLetter("l")
	onM <- function() onLetter("m")
	onN <- function() onLetter("n")
	onO <- function() onLetter("o")
	onP <- function() onLetter("p")
	onQ <- function() onLetter("q")
	onR <- function() onLetter("r")
	onS <- function() onLetter("s")
	onT <- function() onLetter("t")
	onU <- function() onLetter("u")
	onV <- function() onLetter("v")
	onW <- function() onLetter("w")
	onX <- function() onLetter("x")
	onY <- function() onLetter("y")
	onZ <- function() onLetter("z")
	for (letter in c(letters, LETTERS)){
		tkbind(packageBox, paste("<", letter, ">", sep=""),
				get(paste("on", toupper(letter), sep="")))
	}
	onClick <- function() tkfocus(packageBox)
	tkbind(packageBox, "<ButtonPress-1>", onClick)
	onOK <- function(){
		datasetName <- datasets[as.numeric(tkcurselection(datasetBox)) + 1]
		dsnameValue <- tclvalue(dsname)
		if (dsnameValue != "" && is.null(package)){
			closeDialog()
			if (is.element(dsnameValue, listDataSets())) {
				if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
					if (GrabFocus()) tkgrab.release(top)
					tkdestroy(top)
					readDataFromPackage()
					return()
				}
			}
			save.options <- options(warn=2)
			check <- try(eval(parse(text=logger(paste("data(", dsnameValue, ")", sep=""))),
							envir=.GlobalEnv), silent=TRUE)
			options(save.options)
			if (inherits(check, "try-error")){
				errorCondition(recall=readDataFromPackage,
						message=sprintf(gettextRcmdr("Data set %s does not exist"), dsnameValue))
				return()
			}
			activeDataSet(dsnameValue)
			tkfocus(CommanderWindow())
		}
		else{
			if (is.null(package)) {
				errorCondition(recall=readDataFromPackage, message=gettextRcmdr("You must select a package."))
				return()
			}
			if (length(datasetName) == 0) {
				errorCondition(recall=readDataFromPackage, message=gettextRcmdr("You must select a data set.")    )
				return()
			}
			if (is.element(datasetName, listDataSets())) {
				if ("no" == tclvalue(checkReplace(datasetName, gettextRcmdr("Data set")))){
					if (GrabFocus()) tkgrab.release(top)
					tkdestroy(top)
					readDataFromPackage()
					return()
				}
			}
			closeDialog()
			command <- paste("data(", datasetName, ', package="', package, '")', sep="")
			result <- justDoIt(command)
			logger(command)
			if (class(result)[1] !=  "try-error") activeDataSet(datasetName)
			tkfocus(CommanderWindow())
		}
	}
	onDataHelp <- function(){
#		datasetName <- data(package=package)$results[as.numeric(tkcurselection(datasetBox)) + 1,3]
    datasetName <- datasets[as.numeric(tkcurselection(datasetBox)) + 1]
		dsnameValue <- tclvalue(dsname)
		if (dsnameValue == "") dsnameValue <- datasetName
		if (length(dsnameValue) == 0) Message(gettextRcmdr("No data set selected."), type="warning")
		else if (is.null(package)) doItAndPrint(paste('help("', dsnameValue, '")', sep=""))
		else doItAndPrint(paste('help("', dsnameValue, '", package="', package, '")', sep=""))
	}
	OKCancelHelp(helpSubject="readDataFromPackage")
	dataHelpButton <- buttonRcmdr(top, text=gettextRcmdr("Help on selected data set"), command=onDataHelp)
	tkgrid(labelRcmdr(packageDatasetFrame, text=gettextRcmdr("Package (Double-click to select)"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"),
			labelRcmdr(packageDatasetFrame, text="   "), labelRcmdr(packageDatasetFrame, text=gettextRcmdr("Data set (Double-click to select)"),
					fg=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
	tkgrid(packageBox, packageScroll, sticky="nw")
	tkgrid(datasetBox, datasetScroll, sticky="nw")
	tkgrid(packageFrame, labelRcmdr(packageDatasetFrame, text="   "), datasetFrame, sticky="nw")
	tkgrid(packageDatasetFrame, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("OR"), fg="red"), sticky="w")
	tkgrid(labelRcmdr(enterFrame, text=gettextRcmdr("Enter name of data set:  "), fg=getRcmdr("title.color"), font="RcmdrTitleFont"), entryDsname, sticky="w")
	tkgrid(enterFrame, sticky="w")
	tkgrid(dataHelpButton, sticky="w")
	tkgrid(buttonsFrame, sticky="ew")
	tkgrid.configure(packageScroll, sticky="ns")
	tkgrid.configure(datasetScroll, sticky="ns")
	tkbind(packageBox, "<Double-ButtonPress-1>", onPackageSelect)
	tkbind(datasetBox, "<Double-ButtonPress-1>", onDatasetSelect)
	dialogSuffix(focus=entryDsname)
}

importSAS <- function() {
    # the following local function is adapted from ?chartr
    capwords <- function(s) {
        cap <- function(s) paste(toupper(substring(s,1,1)), {s <- substring(s, 2); tolower(s)}, sep = "", collapse = " " )
        sapply(strsplit(s, split = " "), cap)
    }
    Library("foreign")
    file <- tclvalue(tkgetOpenFile(
        filetypes=gettextRcmdr('{"All Files" {"*"}} {"SAS xport files" {".xpt" ".XPT" ".xport" ".XPORT"}}')))
    if (file == "") {
        tkfocus(CommanderWindow())
        return()
    }
    command <- paste('read.xport("', file,'")', sep="")
    logger(paste(".Datasets <- ", command, sep=""))
    result <- justDoIt(command)
    if (class(result)[1] !=  "try-error"){
        gassign(".Datasets", result)
        if (is.data.frame(.Datasets)){
            getdsname <- function(){
                initializeDialog(title=gettextRcmdr("Data Set Name"))
                dsname <- tclVar("Dataset")
                entryDsname <- ttkentry(top, width="20", textvariable=dsname)
                onOK <- function(){
                    closeDialog()
                    setBusyCursor()
                    on.exit(setIdleCursor())
                    dsnameValue <- trim.blanks(tclvalue(dsname))
                    if (dsnameValue == ""){
                        errorCondition(recall=getdsname,
                                       message=gettextRcmdr("You must enter the name of a data set."))
                        return()
                    }
                    if (!is.valid.name(dsnameValue)){
                        errorCondition(recall=getdsname,
                                       message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
                        return()
                    }
                    if (is.element(dsnameValue, listDataSets())) {
                        if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                            getdsname()
                            return()
                        }
                    }
                    doItAndPrint(paste(dsnameValue, " <- .Datasets", sep=""))
                    logger("remove(.Datasets)")
                    remove(".Datasets", envir=.GlobalEnv)
                    activeDataSet(dsnameValue)
                }
                OKCancelHelp()
                tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="w")
                tkgrid(buttonsFrame, columnspan="2", sticky="w")
                tkgrid.configure(entryDsname, sticky="w")
                dialogSuffix(focus=entryDsname)
            }
            getdsname()
        }
        else {
            fmt <- grep("^FORMAT", names(.Datasets))
            if (length(fmt) >= 1) gassign(".Datasets", .Datasets[-fmt])
            if (length(.Datasets) == 1){
                dsname <- capwords(names(.Datasets))
                if (is.element(dsname, listDataSets())) {
                    if ("no" == tclvalue(checkReplace(dsname, gettextRcmdr("Data set")))){
                        importSAS()
                        return()
                    }
                }
                doItAndPrint(paste(dsname, " <- .Datasets[[1]]", sep=""))
                doItAndPrint(paste("colnames(", dsname, ") <- ", "tolower(colnames(", 
                                   dsname, "))", sep=""))
                logger("remove(.Datasets)")
                remove(".Datasets", envir=.GlobalEnv)
                activeDataSet(dsname)
            }
            else {
                dsnames <- capwords(names(.Datasets))
                datasets <- listDataSets()
                initializeDialog(title=gettextRcmdr("Select Dataset"))
                datasetsBox <- variableListBox(top, dsnames, 
                                               title=gettextRcmdr("Datasets in file (pick one)"),
                                               initialSelection=0)
                onOK <- function() {
                    dsname <- getSelection(datasetsBox)
                    for (ds in 1:length(dsnames)){
                        if (is.element(dsnames[ds], datasets)) {
                            if ("no" == tclvalue(checkReplace(dsnames[ds], gettextRcmdr("Data set")))){
                                next()
                            }
                        }
                        doItAndPrint(paste(dsnames[ds], " <- .Datasets[[", ds, "]]", sep=""))
                        doItAndPrint(paste("colnames(", dsnames[ds], ") <- ", "tolower(colnames(", 
                                           dsnames[ds], "))", sep=""))
                    }
                    logger("remove(.Datasets)")
                    remove(".Datasets", envir=.GlobalEnv)
                    activeDataSet(dsname)
                    closeDialog()
                    tkfocus(CommanderWindow())
                }
                OKCancelHelp(helpSubject="read.xport")
                tkgrid(getFrame(datasetsBox), sticky="w")
                tkgrid(buttonsFrame, sticky="w")
                dialogSuffix()
            }
        }
    }
    tkfocus(CommanderWindow())
}

importSASb7dat <- function() {
    initializeDialog(title=gettextRcmdr("Import SAS b7dat Data Set"))
    dsname <- tclVar("Dataset")
    dsnameFrame <- tkframe(top)
    entryDsname <- ttkentry(dsnameFrame, width="20", textvariable=dsname)
    optionsFrame <- tkframe(top)
    asFactor <- tclVar("1")
    asFactorCheckBox <- ttkcheckbutton(optionsFrame, variable=asFactor)
    asDate <- tclVar("1")
    rownames <- tclVar("0")
    rownamesCheckBox <- ttkcheckbutton(optionsFrame, variable=rownames)
    onOK <- function(){
        closeDialog()
        setBusyCursor()
        on.exit(setIdleCursor())
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == ""){
            errorCondition(recall=importSASb7dat,
                           message=gettextRcmdr("You must enter the name of a data set."))
            return()
        }
        if (!is.valid.name(dsnameValue)){
            errorCondition(recall=importSASb7dat,
                           message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                importSASb7dat()
                return()
            }
        }
        file <- tclvalue(tkgetOpenFile(
            filetypes=gettextRcmdr('{"All Files" {"*"}} {"SAS b7dat dataset" {".sas7bdat" ".SAS7BDAT"}}')))
        if (file == "") {
            tkfocus(CommanderWindow())
            return()
        }
        factor <- tclvalue(asFactor) == "1"
        has.rownames <- tclvalue(rownames) ==  "1"
        command <- paste('readSAS("', file, '", stringsAsFactors=', factor, ", rownames=", has.rownames, ")", sep="")
        logger(paste(dsnameValue, " <- ", command, sep=""))
        result <- justDoIt(command)
        if (class(result)[1] !=  "try-error"){
            gassign(dsnameValue, result)
            activeDataSet(dsnameValue)
        }
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="readSAS")
    tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Enter name for data set:  ")), entryDsname, sticky="w")
    tkgrid(dsnameFrame, columnspan=2, sticky="w")
    tkgrid(asFactorCheckBox, labelRcmdr(optionsFrame, text=gettextRcmdr("Convert character variables to factors"), justify="left"),
           sticky="nw")
    tkgrid(rownamesCheckBox, labelRcmdr(optionsFrame, text=gettextRcmdr("First column contains row names"), justify="left"),
           sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(buttonsFrame, columnspan="2", sticky="ew")
    dialogSuffix(focus=entryDsname)
}

importSPSS <- function() {
    initializeDialog(title=gettextRcmdr("Import SPSS Data Set"))
    dsnameFrame <- tkframe(top)
    dsname <- tclVar("Dataset")
    entryDsname <- ttkentry(dsnameFrame, width="20", textvariable=dsname)
    asFactorFrame <- tkframe(top)
    asFactor <- tclVar("1")
    asFactorCheckBox <- ttkcheckbutton(asFactorFrame, variable=asFactor)
    toLowerFrame <- tkframe(top)
    toLower <- tclVar("0")
    toLowerCheckBox <- ttkcheckbutton(toLowerFrame, variable=toLower)
    rowNamesFrame <- tkframe(top)
    rownames <- tclVar("0")
    rownamesCheckBox <- ttkcheckbutton(rowNamesFrame, variable=rownames)
    onOK <- function(){
        closeDialog()
        setBusyCursor()
        on.exit(setIdleCursor())
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == ""){
            errorCondition(recall=importSPSS,
                           message=gettextRcmdr("You must enter the name of a data set."))
            return()
        }
        if (!is.valid.name(dsnameValue)){
            errorCondition(recall=importSPSS,
                           message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                importSPSS()
                return()
            }
        }
        file <- tclvalue(tkgetOpenFile(
            filetypes=gettextRcmdr('{"All Files" {"*"}} {"SPSS portable files" {".por" ".POR"}} {"SPSS save files" {".sav" ".SAV"}}')))
        if (file == "") {
            tkfocus(CommanderWindow())
            return()
        }
        factor <- tclvalue(asFactor) == "1"
        lower <- tclvalue(toLower) == "1"
        rows <- tclvalue(rownames) == "1"
        command <- paste('readSPSS("', file,'", rownames=', rows, ", stringsAsFactors=", factor, ", tolower=", lower, ")", sep="")
        logger(paste(dsnameValue, " <- ", command, sep=""))
        result <- justDoIt(command)
        if (class(result)[1] !=  "try-error"){
            gassign(dsnameValue, result)
            activeDataSet(dsnameValue)
        }
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="readSPSS")
    tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Enter name for data set:  ")), entryDsname, sticky="w")
    tkgrid(dsnameFrame, sticky="w")
    tkgrid(asFactorCheckBox, labelRcmdr(asFactorFrame, text=gettextRcmdr("Convert character variables to factors"), justify="left"),
           sticky="nw")
    tkgrid(asFactorFrame, sticky="w")
    tkgrid(rownamesCheckBox, labelRcmdr(rowNamesFrame, text=gettextRcmdr("First column contains row names"), justify="left"),
           sticky="w")
    tkgrid(rowNamesFrame, sticky="w")
    tkgrid(toLowerCheckBox, labelRcmdr(toLowerFrame, text=gettextRcmdr("Convert variable names to lower case"), justify="left"),
           sticky="nw")
    tkgrid(toLowerFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="ew")
    dialogSuffix(focus=entryDsname)
}

# importSPSS <- function() {
#     Library("foreign")
#     initializeDialog(title=gettextRcmdr("Import SPSS Data Set"))
#     dsnameFrame <- tkframe(top)
#     dsname <- tclVar("Dataset")
#     entryDsname <- ttkentry(dsnameFrame, width="20", textvariable=dsname)
#     asFactorFrame <- tkframe(top)
#     asFactor <- tclVar("1")
#     asFactorCheckBox <- ttkcheckbutton(asFactorFrame, variable=asFactor)
#     toLowerFrame <- tkframe(top)
#     toLower <- tclVar("1")
#     toLowerCheckBox <- ttkcheckbutton(toLowerFrame, variable=toLower)
#     maxLevelsFrame <- tkframe(top)
#     maxLevels <- tclVar("Inf")
#     entryMaxLevels <- ttkentry(maxLevelsFrame, width="5", textvariable=maxLevels)
#     onOK <- function(){
#         closeDialog()
#         setBusyCursor()
#         on.exit(setIdleCursor())
#         dsnameValue <- trim.blanks(tclvalue(dsname))
#         if (dsnameValue == ""){
#             errorCondition(recall=importSPSS,
#                            message=gettextRcmdr("You must enter the name of a data set."))
#             return()
#         }
#         if (!is.valid.name(dsnameValue)){
#             errorCondition(recall=importSPSS,
#                            message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
#             return()
#         }
#         if (is.element(dsnameValue, listDataSets())) {
#             if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
#                 importSPSS()
#                 return()
#             }
#         }
#         file <- tclvalue(tkgetOpenFile(
#             filetypes=gettextRcmdr('{"All Files" {"*"}} {"SPSS portable files" {".por" ".POR"}} {"SPSS save files" {".sav" ".SAV"}}')))
#         if (file == "") {
#             tkfocus(CommanderWindow())
#             return()
#         }
#         factor <- tclvalue(asFactor) == "1"
#         levels <- as.numeric(tclvalue(maxLevels))
#         command <- paste('read.spss("', file,'", use.value.labels=', factor,
#                          ", max.value.labels=", levels, ", to.data.frame=TRUE)", sep="")
#         logger(paste(dsnameValue, " <- ", command, sep=""))
#         result <- justDoIt(command)
#         if (class(result)[1] !=  "try-error"){
#             gassign(dsnameValue, result)
#             if (tclvalue(toLower) == "1") 
#                 doItAndPrint(paste("colnames(", dsnameValue, ") <- tolower(colnames(",
#                                    dsnameValue, "))", sep=""))
#             activeDataSet(dsnameValue)
#         }
#         tkfocus(CommanderWindow())
#     }
#     OKCancelHelp(helpSubject="read.spss")
#     tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Enter name for data set:  ")), entryDsname, sticky="w")
#     tkgrid(dsnameFrame, sticky="w")
#     tkgrid(asFactorCheckBox, labelRcmdr(asFactorFrame, text=gettextRcmdr("Convert value labels\nto factor levels"), justify="left"),
#            sticky="nw")
#     tkgrid(asFactorFrame, sticky="w")
#     tkgrid(toLowerCheckBox, labelRcmdr(toLowerFrame, text=gettextRcmdr("Convert variable names\nto lower case"), justify="left"),
#            sticky="nw")
#     tkgrid(toLowerFrame, sticky="w")
#     tkgrid(labelRcmdr(maxLevelsFrame, text=gettextRcmdr("Maximum number\nof value labels\nfor factor conversion"), justify="left"),
#            entryMaxLevels, sticky="nw")
#     tkgrid(maxLevelsFrame, sticky="w")
#     tkgrid(buttonsFrame, sticky="ew")
#     dialogSuffix(focus=entryDsname)
# }

importMinitab <- function() {
	Library("foreign")
	initializeDialog(title=gettextRcmdr("Import Minitab Data Set"))
	dsname <- tclVar("Dataset")
	entryDsname <- ttkentry(top, width="20", textvariable=dsname)
	onOK <- function(){
		closeDialog()
		setBusyCursor()
		on.exit(setIdleCursor())
		dsnameValue <- trim.blanks(tclvalue(dsname))
		if (dsnameValue == ""){
			errorCondition(recall=importMinitab,
					message=gettextRcmdr("You must enter the name of a data set."))
			return()
		}
		if (!is.valid.name(dsnameValue)){
			errorCondition(recall=importMinitab,
					message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsnameValue, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
				importMinitab()
				return()
			}
		}
		file <- tclvalue(tkgetOpenFile(
						filetypes=gettextRcmdr('{"All Files" {"*"}} {"Minitab portable files" {".mtp" ".MTP"}}')))
		if (file == "") {
			tkfocus(CommanderWindow())
			return()
		}
		command <- paste('read.mtp("', file,'")', sep="")
		datalist <- justDoIt(command)
		lengths <- sapply(datalist, length)
		datalist <- datalist[lengths != 0]
		lengths <- lengths[lengths != 0]
		if (!all(lengths == length(datalist[[1]]))){
			Message(message=
							paste(gettextRcmdr("Minitab data set contains elements of unequal length.\nData set cannot be converted.")),
					type="error")
			tkdestroy(top)
			tkfocus(CommanderWindow())
			return()
		}
		doItAndPrint(paste(dsnameValue, " <- as.data.frame(", command, ")", sep=""))
		activeDataSet(dsnameValue)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="read.mtp")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="e")
	tkgrid(buttonsFrame, columnspan="2", sticky="w")
	tkgrid.configure(entryDsname, sticky="w")
	dialogSuffix(focus=entryDsname)
}

# the following function was contributed by Michael Ash (modified by J. Fox)

importSTATA <- function() {
    initializeDialog(title=gettextRcmdr("Import STATA Data Set"))
    dsname <- tclVar("Dataset")
    dsnameFrame <- tkframe(top)
    entryDsname <- ttkentry(dsnameFrame, width="20", textvariable=dsname)
    optionsFrame <- tkframe(top)
    asFactor <- tclVar("1")
    asFactorCheckBox <- ttkcheckbutton(optionsFrame, variable=asFactor)
    asDate <- tclVar("1")
    asDateCheckBox <- ttkcheckbutton(optionsFrame, variable=asDate)
    rownames <- tclVar("0")
    rownamesCheckBox <- ttkcheckbutton(optionsFrame, variable=rownames)
    onOK <- function(){
        closeDialog()
        setBusyCursor()
        on.exit(setIdleCursor())
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == ""){
            errorCondition(recall=importSTATA,
                           message=gettextRcmdr("You must enter the name of a data set."))
            return()
        }
        if (!is.valid.name(dsnameValue)){
            errorCondition(recall=importSTATA,
                           message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                importSTATA()
                return()
            }
        }
        file <- tclvalue(tkgetOpenFile(
            filetypes=gettextRcmdr('{"All Files" {"*"}} {"STATA datasets" {".dta" ".DTA"}}')))
        if (file == "") {
            tkfocus(CommanderWindow())
            return()
        }
        convert.date <- tclvalue(asDate) == "1"
        factor <- tclvalue(asFactor) == "1"
        has.rownames <- tclvalue(rownames) ==  "1"
        command <- paste('readStata("', file,'", convert.dates=', convert.date,
                         ", stringsAsFactors=", factor, ", rownames=", has.rownames, ")", sep="")
        logger(paste(dsnameValue, " <- ", command, sep=""))
        result <- justDoIt(command)
        if (class(result)[1] !=  "try-error"){
            gassign(dsnameValue, result)
            activeDataSet(dsnameValue)
        }
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="readStata")
    tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Enter name for data set:  ")), entryDsname, sticky="w")
    tkgrid(dsnameFrame, columnspan=2, sticky="w")
    tkgrid(asFactorCheckBox, labelRcmdr(optionsFrame, text=gettextRcmdr("Convert character variables to factors"), justify="left"),
           sticky="nw")
    tkgrid(asDateCheckBox, labelRcmdr(optionsFrame, text=gettextRcmdr("Convert dates to R format"), justify="left"),
           sticky="w")
    tkgrid(rownamesCheckBox, labelRcmdr(optionsFrame, text=gettextRcmdr("First column contains row names"), justify="left"),
           sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(buttonsFrame, columnspan="2", sticky="ew")
    dialogSuffix(focus=entryDsname)
}

# The following function was contributed by Matthieu Lesnoff
#  (added with small changes by J. Fox)

# importRODBCtable <- function(){
# 	Library("RODBC")
# 	# close all databases in case of error
# 	on.exit(odbcCloseAll())
# # Enter the name of data set, by default : Dataset
# 	initializeDialog(title = gettextRcmdr("Import from Excel, Access or dBase data set"))
# 	dsname <- tclVar(gettextRcmdr("Dataset"))
# 	entryDsname <- ttkentry(top, width = "35", textvariable = dsname)
# 	onOK <- function(){
# 		closeDialog()
# 		setBusyCursor()
# 		on.exit(setIdleCursor())
# 		dsnameValue <- trim.blanks(tclvalue(dsname))
# 		if(dsnameValue == ""){
# 			errorCondition(recall = importRODBCtable,
# 					message = gettextRcmdr("You must enter the name of a data set."))
# 			return()
# 		}
# 		if(!is.valid.name(dsnameValue)){
# 			errorCondition(recall = queryimportRODBCtable,
# 					message = paste('"', dsnameValue, '" ',
# 							gettextRcmdr("is not a valid name."), sep = ""))
# 			return()
# 		}
# 		if(is.element(dsnameValue, listDataSets())){
# 			if("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
# 				importRODBCtable()
# 				return()
# 			}
# 		}
# 		File <- tclvalue(tkgetOpenFile(filetypes = gettextRcmdr(
# 								'{"All Files" {"*"}} {"MS Access database" {".mdb" ".MDB"}} {"MS Access 2007 database" {".accdb" ".ACCDB"}} {"dBase-like file" {".dbf" ".DBF"}} {"MS Excel 2007 file" {".xlsx" ".XLSX"}} {"MS Excel file" {".xls" ".XLS"}}'
# 						), parent=CommanderWindow()))
# 		if(File == ""){
# 			tkfocus(CommanderWindow())
# 			return()
# 		}
# 		sop <- match(".", rev(strsplit(File, NULL)[[1]]))[1]
# 		ext <- tolower(substring(File, nchar(File) - sop + 2, nchar(File)))
# 		channel <- switch(EXPR = ext,
# 				xls = odbcConnectExcel(File),
# 				xlsx = odbcConnectExcel2007(File),
# 				mdb = odbcConnectAccess(File),
# 				accdb = odbcConnectAccess2007(File),
# 				dbf = odbcConnectDbase(File))
# 		# For Excel and Access cases, need to select a particular sheet or table
# 		if(ext != "dbf"){
# 			tabdat <- sqlTables(channel)
# 			names(tabdat) <- tolower(names(tabdat))
# 			if(ext == "mdb" || ext == "accdb")
# 				tabdat <- tabdat[tabdat$table_type == "TABLE", 3]
# 			if(ext == "xls" || ext == "xlsx"){
# 				tabname <- tabdat$table_name
# 				tabdat <- ifelse(tabdat$table_type =="TABLE",
# 						substring(tabname, 2, nchar(tabname) - 2),
# 						substring(tabname, 1, nchar(tabname) - 1))
# 			}
# 			# if there are several tables
# 			if(length(tabdat)>1)
# 				fil <- tk_select.list(sort(tabdat),
# 						title = gettextRcmdr("Select one table"))
# 			else
# 				fil <- tabdat
# 			if(fil == ""){
# 				errorCondition(message=gettextRcmdr("No table selected"))
# 				return()
# 			}
# 			if(ext == "xls" || ext == "xlsx")
# 				fil <- paste("[", fil, "$]", sep = "")
# 		}
# 		# dBase file
# 		else{
# 			sop <- match(".", rev(strsplit(File, NULL)[[1]]))[1]
# 			root <- tolower(substring(File, 1, nchar(File) - sop))
# 			revstr <- rev(strsplit(root, NULL)[[1]])
# 			sop <- if(is.na(match(c("/", "\\"), revstr)[1]))
# 						length(revstr) else match(c("/", "\\"), revstr)[1] - 1
# 			toor <- revstr[seq(sop)]
# 			fil <- paste(rev(toor), collapse = "")
# 		}
# 		# Retrieve the data
# 		dat <- sqlQuery(channel = channel, query = paste("select * from", fil))
# 		names(dat)<- trim.blanks(names(dat))
# 		dat <- trim.col.na(dat)
# 		odbcCloseAll()
# 		gassign(dsnameValue, as.data.frame(dat))
# 		command <- paste("sqlQuery(channel = ",channel,", select * from ", fil,")",
# 				sep = "")
# 		logger(paste(dsnameValue, " <- ", command, sep = ""))
# 		activeDataSet(dsnameValue)
# 		tkfocus(CommanderWindow())
# 	}  ## End of function onOK
# 	OKCancelHelp(helpSubject="odbcConnect")
# 	tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter name of data set:  ")),
# 			entryDsname, sticky="e")
# 	tkgrid(buttonsFrame, columnspan="2", sticky="w")
# 	tkgrid.configure(entryDsname, sticky="w")
# 	dialogSuffix(focus=entryDsname)
# }

# importExcel <- function(){
#   Library("XLConnect")
#   initializeDialog(title = gettextRcmdr("Import Excel Data Set"))
#   dsname <- tclVar(gettextRcmdr("Dataset"))
#   dsnameFrame <- tkframe(top)
#   entryDsname <- ttkentry(dsnameFrame, width = "35", textvariable = dsname)
#   checkBoxFrame <- tkframe(top)
#   variableNames <- tclVar("1")
#   variableNamesCheckBox <- ttkcheckbutton(checkBoxFrame, variable=variableNames)
#   rowNames <- tclVar("0")
#   rowNamesCheckBox <- ttkcheckbutton(checkBoxFrame, variable=rowNames)
#   onOK <- function(){
#     closeDialog()
#     setBusyCursor()
#     on.exit(setIdleCursor())
#     dsnameValue <- trim.blanks(tclvalue(dsname))
#     variableNamesValue <- tclvalue(variableNames)
#     rowNamesValue <- tclvalue(rowNames)
#     if(dsnameValue == ""){
#       errorCondition(recall = importExcel,
#                      message = gettextRcmdr("You must enter the name of a data set."))
#       return()
#     }
#     if(!is.valid.name(dsnameValue)){
#       errorCondition(recall = importExcel,
#                      message = paste('"', dsnameValue, '" ',
#                                      gettextRcmdr("is not a valid name."), sep = ""))
#       return()
#     }
#     if(is.element(dsnameValue, listDataSets())){
#       if("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
#         importExcel()
#         return()
#       }
#     }
#     File <- tclvalue(tkgetOpenFile(filetypes = gettextRcmdr(
#       '{"All Files" {"*"}} {"MS Excel 2007 file" {".xlsx" ".XLSX"}} {"MS Excel file" {".xls" ".XLS"}}'
#     ), parent=CommanderWindow()))
#     if(File == ""){
#       tkfocus(CommanderWindow())
#       return()
#     }
#     command <- paste('loadWorkbook("', File, '")', sep="")
#     doItAndPrint(paste(".Workbook <- ", command, sep=""))
#     worksheets <- getSheets(.Workbook)
#     if(length(worksheets)>1)
#       worksheet <- tk_select.list(worksheets,
#                                   title = gettextRcmdr("Select one table"))
#     else
#       worksheet <- worksheets
#     if(worksheet == ""){
#       errorCondition(message=gettextRcmdr("No table selected"))
#       return()
#     }
#     command <- paste('readWorksheet(.Workbook, "', worksheet,
#                      '", header=', if (variableNamesValue == "1") 'TRUE' else 'FALSE',
#                      ', rownames=', if(rowNamesValue == "1") '1' else 'NULL',
#                      ')', sep="")
#     logger(paste(dsnameValue, " <- ", command, sep=""))
#     result <- justDoIt(command)
#     if (class(result)[1] !=  "try-error"){
#       gassign(dsnameValue, result)
#     }
#     logger("remove(.Workbook)")
#     justDoIt("remove(.Workbook, envir=.GlobalEnv)")
#     if (class(result)[1] !=  "try-error"){
#       factors <- sapply(get(dsnameValue, envir=.GlobalEnv), is.character)
#       if (any(factors)){
#         factors <- which(factors)
#         command <- paste(dsnameValue, "[, c(", paste(factors, collapse=", "), 
#                          ")] <- lapply(", dsnameValue, "[, c(", 
#                          paste(factors, collapse=", "), "), drop=FALSE], as.factor)",
#                          sep="")
#         doItAndPrint(command)
#       }
#       activeDataSet(dsnameValue)
#     }
#   }
#   OKCancelHelp(helpSubject="readWorksheet")
#   tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Enter name of data set: ")),
#          entryDsname, sticky="w")
#   tkgrid(dsnameFrame, sticky="w")
#   tkgrid(variableNamesCheckBox, labelRcmdr(checkBoxFrame, text=gettextRcmdr("Variable names in first row of spreadsheet")),
#          sticky="w")
#   tkgrid(rowNamesCheckBox, labelRcmdr(checkBoxFrame, text=gettextRcmdr("Row names in first column of spreadsheet")),
#          sticky="w")
#   tkgrid(checkBoxFrame, sticky="w")
#   tkgrid(buttonsFrame, sticky="w")
#   dialogSuffix(focus=entryDsname)
# }

importExcel <- function(){
    initializeDialog(title = gettextRcmdr("Import Excel Data Set"))
    dsname <- tclVar("Dataset")
    dsnameFrame <- tkframe(top)
    entryDsname <- ttkentry(dsnameFrame, width = "35", textvariable = dsname)
    checkBoxFrame <- tkframe(top)
    variableNames <- tclVar("1")
    variableNamesCheckBox <- ttkcheckbutton(checkBoxFrame, variable=variableNames)
    rowNames <- tclVar("0")
    rowNamesCheckBox <- ttkcheckbutton(checkBoxFrame, variable=rowNames)
    stringsAsFactors <- tclVar("1")
    stringsAsFactorsCheckBox <- ttkcheckbutton(checkBoxFrame, variable=stringsAsFactors)
    missingFrame <- tkframe(top)
    missingVariable <- tclVar(gettextRcmdr("<empty cell>"))
    missingEntry <- ttkentry(missingFrame, width="15", textvariable=missingVariable)
    onOK <- function(){
        closeDialog()
        setBusyCursor()
        on.exit(setIdleCursor())
        dsnameValue <- trim.blanks(tclvalue(dsname))
        variableNamesValue <- tclvalue(variableNames)
        rowNamesValue <- tclvalue(rowNames)
        stringsAsFactorsValue <- tclvalue(stringsAsFactors)
        missingValues <- as.character(tclvalue(missingVariable))
        if (missingValues == gettextRcmdr("<empty cell>")) missingValues <- ""
        if(dsnameValue == ""){
            errorCondition(recall = importExcel,
                message = gettextRcmdr("You must enter the name of a data set."))
            return()
        }
        if(!is.valid.name(dsnameValue)){
            errorCondition(recall = importExcel,
                message = paste('"', dsnameValue, '" ',
                    gettextRcmdr("is not a valid name."), sep = ""))
            return()
        }
        if(is.element(dsnameValue, listDataSets())){
            if("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                importExcel()
                return()
            }
        }
        File <- tclvalue(tkgetOpenFile(filetypes = gettextRcmdr(
            '{"All Files" {"*"}} {"MS Excel file" {".xlsx" ".XLSX" ".xls" ".XLS"}}'
        ), parent=CommanderWindow()))
        if(File == ""){
            tkfocus(CommanderWindow())
            return()
        }
        worksheets <- excel_sheets(File)
        if(length(worksheets) > 1)
            worksheet <- tk_select.list(worksheets,
                title = gettextRcmdr("Select one table"))
        else
            worksheet <- worksheets
        if(worksheet == ""){
            errorCondition(message=gettextRcmdr("No table selected"))
            return()
        }
        command <- paste('readXL("', File, '", rownames=', if (rowNamesValue == "1") "TRUE" else "FALSE",
            ", header=", if (variableNamesValue == "1") "TRUE" else "FALSE",
            ', na="', missingValues, '", sheet="', worksheet,
            '", stringsAsFactors=', if(stringsAsFactorsValue == "1") "TRUE" else "FALSE",
            ')', sep="")
        logger(paste(dsnameValue, " <- ", command, sep=""))
        result <- justDoIt(command)
        if (class(result)[1] !=  "try-error"){
            gassign(dsnameValue, result)
            activeDataSet(dsnameValue)
        }
    }
    OKCancelHelp(helpSubject="readXL")
    tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Enter name of data set: ")),
        entryDsname, sticky="w")
    tkgrid(dsnameFrame, sticky="w")
    tkgrid(variableNamesCheckBox, labelRcmdr(checkBoxFrame, text=gettextRcmdr("Variable names in first row of spreadsheet")),
        sticky="w")
    tkgrid(rowNamesCheckBox, labelRcmdr(checkBoxFrame, text=gettextRcmdr("Row names in first column of spreadsheet")),
        sticky="w")
    tkgrid(stringsAsFactorsCheckBox, labelRcmdr(checkBoxFrame, text=gettextRcmdr("Convert character data to factors")),
        sticky="w")
    tkgrid(labelRcmdr(missingFrame, text=gettextRcmdr("Missing data indicator:")), missingEntry, sticky="w")
    tkgrid(checkBoxFrame, sticky="w")
    tkgrid(missingFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(focus=entryDsname)
}


numericToFactor <- function(){
  initializeDialog(title=gettextRcmdr("Convert Numeric Variables to Factors"))
  dataFrame <- tkframe(top)
  variableBox <- variableListBox(dataFrame, Numeric(), selectmode="multiple",
                                 title=gettextRcmdr("Variables (pick one or more)"))
  radioButtons(dataFrame, name="levels", buttons=c("names", "numbers"),
               labels=gettextRcmdr(c("Supply level names", "Use numbers")), title=gettextRcmdr("Factor Levels"))
  factorNameFrame <- tkframe(top)
  factorName <- tclVar(gettextRcmdr("<same as variables>"))
  factorNameField <- ttkentry(factorNameFrame, width="20", textvariable=factorName)
  onOK <- function(){
    variables <- getSelection(variableBox)
    closeDialog()
    facname <- trim.blanks(tclvalue(factorName))
    .activeDataSet <- ActiveDataSet()
    cmd <- paste("apply(", .activeDataSet, "[, c(", paste(
      paste('"', variables, '"', sep=""),
      collapse=","), "), drop=FALSE], 2, function(x) sort(unique(x)))", sep="")
    levs <- eval(parse(text=cmd), envir=.GlobalEnv)
    sameLevels <- (length(variables) == 1) ||
      ((is.matrix(levs)) && (all(0 == apply(levs, 1, var))))
    if (length(variables) == 0) {
      errorCondition(recall=numericToFactor, message=gettextRcmdr("You must select a variable."))}
    else command <- paste(.activeDataSet, " <- within(", .activeDataSet, ", {", sep="")
    for (name in variables){
      fname <- if (facname == gettextRcmdr("<same as variables>")) name
      else if (length(variables) == 1) facname
      else paste(facname, name, sep="")
      if (!is.valid.name(fname)){
        errorCondition(recall=numericToFactor,
                       message=paste('"', fname, '" ', gettextRcmdr("is not a valid name."), sep=""))
        return()
      }
      if (is.element(fname, Variables())) {
        if ("no" == tclvalue(checkReplace(fname))){
          numericToFactor()
          return()
        }
      }
      levelsType <- tclvalue(levelsVariable)
      env <- environment()
      if (((name == variables[1]) || (!sameLevels)) && (levelsType == "names")){
        values <- sort(unique(eval(parse(text=paste(.activeDataSet, "$", name, sep="")),
                                   envir=.GlobalEnv)))
        nvalues <- length(values)
        if (nvalues > 30) {
          errorCondition(recall=numericToFactor,
                         message=sprintf(gettextRcmdr("Number of levels (%d) too large."), nvalues))
          return()
        }
        initializeDialog(subdialog,
                         title=paste(gettextRcmdr("Level Names for"),
                                     if(sameLevels && length(variables) > 1) "Factors" else fname))
        names <- rep("", nvalues)
        onOKsub <- function() {
          closeDialog(subdialog)
          for (i in 1:nvalues){
            names[i] <- eval(parse(text=paste("tclvalue(levelName", i, ")", sep="")))
          }
          if (length(unique(names)) != nvalues){
            errorCondition(recall=numericToFactor,
                           message=gettextRcmdr("Levels names are not unique."))
            return()
          }
          if (any(names == "")){
            errorCondition(recall=numericToFactor,
                           message=gettextRcmdr("A level name is empty."))
            return()
          }
          assign("labels", paste(paste("'", names, "'", sep=""), collapse=","),
                 envir=env)
        }
        subOKCancelHelp()
        tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Numeric value")), labelRcmdr(subdialog, text=gettextRcmdr("Level name")), sticky="w")
        for (i in 1:nvalues){
          valVar <- paste("levelName", i, sep="")
          assign(valVar, tclVar(""))
          assign(paste("entry", i, sep=""), ttkentry(subdialog, width="20",
                                                     textvariable=get(valVar)))
          tkgrid(labelRcmdr(subdialog, text=values[i]), get(paste("entry", i, sep="")), sticky="w")
        }
        tkgrid(subButtonsFrame, sticky="w", columnspan=2)
        dialogSuffix(subdialog, focus=entry1, onOK=onOKsub, force.wait=TRUE)
      }
      if (levelsType == "names"){
        if (!exists("labels", mode="character")) return()
        cmd <- paste("factor(", name,
                     ", labels=c(", labels, "))", sep="")
        command <- paste(command, "\n  ", fname, " <- ", cmd, sep="")
      }
      else{
        command <- paste(command, "\n  ", fname, " <- as.factor(", name, ")", sep="")
      }
    }
    command <- paste(command, "\n})", sep="")
    result <- doItAndPrint(command)
    if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE, flushDialogMemory=FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="factor")
  tkgrid(getFrame(variableBox), labelRcmdr(dataFrame, text="  "), levelsFrame, sticky="nw")
  tkgrid(dataFrame, sticky="w")
  tkgrid(labelRcmdr(factorNameFrame,
                    text=gettextRcmdr("New variable name or prefix for multiple variables:  ")),
         factorNameField, sticky="w")
  tkgrid(factorNameFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="ew", columnspan=2)
  tkgrid.configure(numbersButton, sticky="w")
  tkgrid.configure(namesButton, sticky="w")
  dialogSuffix(preventGrabFocus=TRUE)
}

binVariable <- function () {
  # Author: Dan Putler (revision by J. Fox, 2 Feb 05)
  defaults <- list (initial.levels = "specify", initial.bins = "3", initial.varName = NULL, 
                    initial.newVar = "variable", initial.method = "intervals")
  dialog.values <- getDialog ("binVariable", defaults)
  env <- environment()
  initializeDialog(title = gettextRcmdr("Bin a Numeric Variable"))
  variableFrame <- tkframe(top)
  variableBox <- variableListBox(variableFrame, Numeric(), 
                                 title = gettextRcmdr("Variable to bin (pick one)"), 
                                 initialSelection = varPosn (dialog.values$initial.varName, "numeric"))
  newVariableFrame <- tkframe(variableFrame)
  newVariableName <- tclVar(dialog.values$initial.newVar)
  newVariable <- ttkentry(newVariableFrame, width = "18", textvariable = newVariableName)
  binsFrame <- tkframe(top)
  binsVariable <- tclVar(dialog.values$initial.bins)
  slider <- tkscale(binsFrame, from = 2, to = 20, showvalue = TRUE, 
                    variable = binsVariable, resolution = 1, orient = "horizontal")
  optionsFrame <- tkframe(top)
  radioButtons(optionsFrame, name = "levels", buttons = c("specify", 
                                                          "numbers", "ranges"), labels = gettextRcmdr(c("Specify names", 
                                                                                                        "Numbers", "Ranges")), title = gettextRcmdr("Level Names"),
               initialValue = dialog.values$initial.levels)
  radioButtons(optionsFrame, name = "method", buttons = c("intervals", 
                                                          "proportions", "natural"), labels = gettextRcmdr(c("Equal-width bins", 
                                                                                                             "Equal-count bins", "Natural breaks\n(from K-means clustering)")), 
               title = gettextRcmdr("Binning Method"), 
               initialValue = dialog.values$initial.method)
  onOK <- function() {
    levels <- tclvalue(levelsVariable)
    bins <- as.numeric(tclvalue(binsVariable))
    varName <- getSelection(variableBox)
    closeDialog()
    if (length(varName) == 0) {
      errorCondition(recall = binVariable, message = gettextRcmdr("You must select a variable."))
      return()
    }
    newVar <- tclvalue(newVariableName)
    if (is.element(newVar, Variables())) {
      if ("no" == tclvalue(checkReplace(newVar))) {
        binVariable()
        return()
      }
    }
    if (!is.valid.name(newVar)) {
      errorCondition(message = paste("\"", newVar, "\" ", 
                                     gettextRcmdr("is not a valid name."), sep = ""), 
                     recall = binVariable)
      return()
    }
    method <- tclvalue(methodVariable)
    putDialog ("binVariable", list (initial.levels = levels, initial.bins = bins, initial.varName = varName, 
                                    initial.newVar = newVar, initial.method = method))
    if (levels == "specify") {
      initializeDialog(subdialog, title = gettextRcmdr("Bin Names"))
      onOKsub <- function() {
        closeDialog(subdialog)
        level <- character(bins)
        for (i in 1:bins) {
          level[i] <- eval(parse(text = paste("tclvalue(levelName", 
                                              i, ")", sep = "")))
        }
        if (length(unique(level)) != length(level)) {
          errorCondition(window = subdialog, message = gettextRcmdr("Level names must be unique."), 
                         recall = onOK)
          return()
        }
        assign("levelNames", level, envir = env)
      }
      subOKCancelHelp()
      tkgrid(labelRcmdr(subdialog, text = gettextRcmdr("Bin"), 
                        fg = getRcmdr("title.color"), font="RcmdrTitleFont"), labelRcmdr(subdialog, text = gettextRcmdr("Name"), 
                                                                                         fg = getRcmdr("title.color"), font="RcmdrTitleFont"), sticky = "w")
      for (i in 1:bins) {
        valVar <- paste("levelName", i, sep = "")
        assign(valVar, tclVar(i))
        assign(paste("entry", i, sep = ""), ttkentry(subdialog, 
                                                     width = "20", textvariable = get(valVar)))
        tkgrid(labelRcmdr(subdialog, text = as.character(i)), 
               get(paste("entry", i, sep = "")), sticky = "w")
      }
      tkgrid(subButtonsFrame, sticky = "w", columnspan = 2)
      dialogSuffix(subdialog, focus = entry1, bindReturn = FALSE, force.wait=TRUE)
    }
    labels <- if (levels == "numbers") 
      "FALSE"
    else if (levels == "ranges") 
      "NULL"
    else {
      if (!exists("levelNames")) {
        onCancel()
        binVariable()
        return()
      }
      paste("c('", paste(levelNames, collapse = "','"), 
            "')", sep = "")
    }
    .activeDataSet <- ActiveDataSet()
    command <- paste(.activeDataSet, "$", newVar, " <- ", 
                     "with(", .activeDataSet, ", binVariable(", varName, ", bins=", 
                     bins, ", method=", "'", method, "', labels=", labels, 
                     "))", sep = "")
    logger(command)
    result <- justDoIt(command)
    if (class(result)[1] != "try-error") 
      activeDataSet(.activeDataSet, flushModel = FALSE, 
                    flushDialogMemory = FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject = "bin.var", reset = "binVariable")
  tkgrid(labelRcmdr(newVariableFrame, text = gettextRcmdr("New variable name"), 
                    fg = getRcmdr("title.color"), font="RcmdrTitleFont"), sticky = "w")
  tkgrid(newVariable, sticky = "w")
  tkgrid(getFrame(variableBox), labelRcmdr(variableFrame, text = "    "), 
         newVariableFrame, sticky = "nw")
  tkgrid(variableFrame, sticky = "w")
  tkgrid(labelRcmdr(binsFrame, text = gettextRcmdr("Number of bins:")), 
         slider, sticky = "s")
  tkgrid(binsFrame, sticky = "w")
  tkgrid(levelsFrame, labelRcmdr(optionsFrame, text = "    "), 
         methodFrame, sticky = "nw")
  tkgrid(optionsFrame, sticky = "w")
  tkgrid(buttonsFrame, sticky = "w")
  dialogSuffix()
}

reorderFactor <- function(){
  initializeDialog(title=gettextRcmdr("Reorder Factor Levels"))
  variableBox <- variableListBox(top, Factors(), title=gettextRcmdr("Factor (pick one)"))
  orderedFrame <- tkframe(top)
  orderedVariable <- tclVar("0")
  orderedCheckBox <- ttkcheckbutton(orderedFrame, variable=orderedVariable)
  factorName <- tclVar(gettextRcmdr("<same as original>"))
  factorNameField <- ttkentry(top, width="20", textvariable=factorName)
  onOK <- function(){
    variable <- getSelection(variableBox)
    closeDialog()
    if (length(variable) == 0) {
      errorCondition(recall=reorderFactor, message=gettextRcmdr("You must select a variable."))
      return()
    }
    name <- trim.blanks(tclvalue(factorName))
    if (name == gettextRcmdr("<same as original>")) name <- variable
    if (!is.valid.name(name)){
      errorCondition(recall=reorderFactor,
                     message=paste('"', name, '" ', gettextRcmdr("is not a valid name."), sep=""))
      return()
    }
    if (is.element(name, Variables())) {
      if ("no" == tclvalue(checkReplace(name))){
        reorderFactor()
        return()
      }
    }
    .activeDataSet <- ActiveDataSet()
    old.levels <- eval(parse(text=paste("levels(", .activeDataSet, "$", variable, ")",
                                        sep="")), envir=.GlobalEnv)
    nvalues <- length(old.levels)
    ordered <- tclvalue(orderedVariable)
    if (nvalues > 30) {
      errorCondition(recall=reorderFactor,
                     message=sprintf(gettextRcmdr("Number of levels (%d) too large."), nvalues))
      return()
    }
    initializeDialog(subdialog, title=gettextRcmdr("Reorder Levels"))
    order <- 1:nvalues
    onOKsub <- function() {
      closeDialog(subdialog)
      opt <- options(warn=-1)
      for (i in 1:nvalues){
        order[i] <- as.numeric(eval(parse(text=paste("tclvalue(levelOrder", i, ")", sep=""))))
      }
      options(opt)
      if (any(sort(order) != 1:nvalues) || any(is.na(order))){
        errorCondition(recall=reorderFactor,
                       message=paste(gettextRcmdr("Order of levels must include all integers from 1 to "), nvalues, sep=""))
        return()
      }
      levels <- old.levels[order(order)]
      ordered <- if (ordered == "1") ", ordered=TRUE" else ""
      command <- paste("with(", .activeDataSet, ", factor(", variable,
                       ", levels=c(", paste(paste("'", levels, "'", sep=""), collapse=","), ")",
                       ordered, "))", sep="")
      result <- justDoIt(paste(.activeDataSet, "$", name, " <- ", command, sep=""))
      logger(paste(.activeDataSet,"$", name," <- ", command, sep=""))
      if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE, flushDialogMemory=FALSE)
    }
    subOKCancelHelp()
    tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Old Levels"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"),
           labelRcmdr(subdialog, text=gettextRcmdr("New order"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
    for (i in 1:nvalues){
      valVar <- paste("levelOrder", i, sep="")
      assign(valVar, tclVar(i))
      assign(paste("entry", i, sep=""), ttkentry(subdialog, width="2",
                                                 textvariable=get(valVar)))
      tkgrid(labelRcmdr(subdialog, text=old.levels[i]), get(paste("entry", i, sep="")), sticky="w")
    }
    tkgrid(subButtonsFrame, sticky="w", columnspan=2)
    dialogSuffix(subdialog, focus=entry1, force.wait=TRUE)
  }
  OKCancelHelp(helpSubject="factor")
  tkgrid(getFrame(variableBox), sticky="nw")
  tkgrid(labelRcmdr(top, text=gettextRcmdr("Name for factor")), sticky="w")
  tkgrid(factorNameField, sticky="w")
  tkgrid(orderedCheckBox, labelRcmdr(orderedFrame, text=gettextRcmdr("Make ordered factor")), sticky="w")
  tkgrid(orderedFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix(preventGrabFocus=TRUE)
}

standardize <- function(X){
  initializeDialog(title=gettextRcmdr("Standardize Variables"))
  xBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Variables (pick one or more)"),
                          selectmode="multiple")
  onOK <- function(){
    x <- getSelection(xBox)
    closeDialog()
    if (length(x) == 0) {
      errorCondition(recall=standardize, message=gettextRcmdr("You must select one or more variables."))
      return()
    }
    xx <- paste('"', x, '"', sep="")
    .activeDataSet <- ActiveDataSet()
    command <- paste(.activeDataSet, " <- ", "local({\n  .Z <- scale(", 
                     .activeDataSet, "[,c(", paste(xx, collapse=","),
                     ")])\n  within(", .activeDataSet, ", {", sep="")
    for (i in length(x):1){
      Z <- paste("Z.", x[i], sep="")
      if (is.element(Z, Variables())) {
        if ("no" == tclvalue(checkReplace(Z))){
          if (GrabFocus()) tkgrab.release(top)
          tkdestroy(top)
          next
        }
      }
      command <- paste(command, "\n    ", Z, " <- .Z[,", i, "]", sep="")
    }
    command <- paste(command, "\n  })\n})")
    result <- doItAndPrint(command)
    if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE, flushDialogMemory=FALSE)
    tkfocus(CommanderWindow()) 
  }
  OKCancelHelp(helpSubject="scale")
  tkgrid(getFrame(xBox), sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix()
}

helpDataSet <- function(){
	.activeDataSet <- ActiveDataSet()
	if (as.numeric(R.Version()$major) >= 2) doItAndPrint(paste('help("', .activeDataSet, '")', sep=""))
	else {
		justDoIt(paste("help('", .activeDataSet, "')", sep=""))
		logger(paste('help("', .activeDataSet, '")', sep=""))
	}
	NULL
}

variablesDataSet <- function(){
	doItAndPrint(paste("names(", ActiveDataSet(), ")", sep=""))
}

exportDataSet <- function() {
    dsname <- activeDataSet()
    initializeDialog(title=gettextRcmdr("Export Active Data Set"))
    checkBoxes(frame="optionsFrame", boxes=c("colnames", "rownames", "quotes"),
               initialValues=rep(1,3), labels=gettextRcmdr(c("Write variable names", "Write row names", "Quotes around character values")))
    missingFrame <- tkframe(optionsFrame)
    missingVariable <- tclVar("NA")
    missingEntry <- ttkentry(missingFrame, width="8", textvariable=missingVariable)
    radioButtons(name="delimiter", buttons=c("spaces", "tabs", "commas", "semicolons"), 
                 labels=gettextRcmdr(c("Spaces", "Tabs", "Commas [,]", "Semicolons [;]")),
                 title=gettextRcmdr("Field Separator"), columns=2)
    otherDelimiterFrame <- tkframe(top)
    otherButton <- ttkradiobutton(otherDelimiterFrame, variable=delimiterVariable, value="other", text=gettextRcmdr("Other"))
    otherVariable <- tclVar("")
    otherEntry <- ttkentry(otherDelimiterFrame, width="4", textvariable=otherVariable)
    onOK <- function(){
        closeDialog()
        col <- tclvalue(colnamesVariable) == 1
        row <- tclvalue(rownamesVariable) == 1
        quote <- tclvalue(quotesVariable) == 1
        delim <- tclvalue(delimiterVariable)
        missing <- tclvalue(missingVariable)
        sep <- if (delim == "tabs") "\\t"
        else if (delim == "spaces") " "
        else if (delim == "commas") ","
        else if (delim == "semicolons") ";"
        else trim.blanks(tclvalue(otherVariable))
        saveFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"All Files" {"*"}} {"Text Files" {".txt" ".TXT" ".dat" ".DAT" ".csv" ".CSV"}}'),
                                           defaultextension=if (delim == "commas") ".csv" else ".txt",
                                           initialfile=paste(dsname, if (delim == "commas") ".csv" else ".txt", sep=""),
                                           parent=CommanderWindow()))
        saveFile <- removeRedundantExtension(saveFile)
        if (saveFile == "") {
            tkfocus(CommanderWindow())
            return()
        }
        command <- paste("write.table(", dsname, ', "', saveFile, '", sep="', sep,
                         '", col.names=', col, ", row.names=", row, ", quote=", quote,
                         ', na="', missing, '")', sep="")
        justDoIt(command)
        logger(command)
        Message(paste(gettextRcmdr("Active dataset exported to file"), saveFile), type="note")
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="write.table")
    tkgrid(labelRcmdr(missingFrame, text=gettextRcmdr("Missing values:  ")), missingEntry, sticky="w")
    tkgrid(missingFrame, sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(delimiterFrame, stick="nw")
    tkgrid(otherButton,
           labelRcmdr(otherDelimiterFrame, text=gettextRcmdr("Specify:")), otherEntry, sticky="w", padx="3")
    tkgrid(otherDelimiterFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix()
}

filterNA <- function(){
    dataSet <- activeDataSet()
    initializeDialog(title=gettextRcmdr("Remove Missing Data"))
    allVariablesFrame <- tkframe(top)
    allVariables <- tclVar("1")
    allVariablesCheckBox <- ttkcheckbutton(allVariablesFrame, variable=allVariables, 
                                           text=gettextRcmdr("Include all variables"))
    variablesBox <- variableListBox(top, Variables(), selectmode="multiple", initialSelection=NULL,
                                    title=gettextRcmdr("Variables (select one or more)"))
    newDataSetName <- tclVar(gettextRcmdr("<same as active data set>"))
    dataSetNameFrame <- tkframe(top)
    dataSetNameEntry <- ttkentry(dataSetNameFrame, width="25", textvariable=newDataSetName)
    onOK <- function(){
        x <- getSelection(variablesBox)
        closeDialog()
        newName <- trim.blanks(tclvalue(newDataSetName))
        .activeDataSet <- ActiveDataSet()
        if (newName == gettextRcmdr("<same as active data set>")) newName <- .activeDataSet
        if (!is.valid.name(newName)){
            errorCondition(recall=filterNA,
                           message=paste('"', newName, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        if (is.element(newName, listDataSets())) {
            if ("no" == tclvalue(checkReplace(newName, gettextRcmdr("Data set")))){
                filterNA()
                return()
            }
        }
        if (tclvalue(allVariables) == "1"){
            command <- paste(newName, " <- na.omit(", .activeDataSet, ")", sep="")
            logger(command)
            result <- justDoIt(command)
            if (class(result)[1] !=  "try-error") activeDataSet(newName)
            tkfocus(CommanderWindow())
        }
        else {
            if (length(x) == 0) {
                errorCondition(recall=filterNA, message=gettextRcmdr("No variables were selected."))
                return()
            }
            x <- paste('"', x, '"', sep="")
            command <- paste(newName, " <- na.omit(", .activeDataSet, "[,c(", paste(x, collapse=","),
                             ')])', sep="")
            logger(command)
            result <- justDoIt(command)
            if (class(result)[1] !=  "try-error") activeDataSet(newName)
            tkfocus(CommanderWindow())
        }
    }
    OKCancelHelp(helpSubject="na.omit")
    tkgrid(allVariablesCheckBox, sticky="w")
    tkgrid(allVariablesFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("   OR"), fg="red"), sticky="w")
    tkgrid(getFrame(variablesBox), sticky="nw")
    tkgrid(labelRcmdr(dataSetNameFrame, text=gettextRcmdr("Name for new data set")), sticky="w")
    tkgrid(dataSetNameEntry, sticky="w")
    tkgrid(dataSetNameFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix()
}

subsetDataSet <- function(){
    dataSet <- activeDataSet()
    initializeDialog(title=gettextRcmdr("Subset Data Set"))
    allVariablesFrame <- tkframe(top)
    allVariables <- tclVar("1")
    allVariablesCheckBox <- ttkcheckbutton(allVariablesFrame, variable=allVariables)
    variablesBox <- variableListBox(top, Variables(), selectmode="multiple",
                                    initialSelection=NULL, title=gettextRcmdr("Variables (select one or more)"))
    subsetVariable <- tclVar(gettextRcmdr("<all cases>"))
    subsetFrame <- tkframe(top)
    subsetEntry <- ttkentry(subsetFrame, width="20", textvariable=subsetVariable)
    subsetScroll <- ttkscrollbar(subsetFrame, orient="horizontal",
                                 command=function(...) tkxview(subsetEntry, ...))
    tkconfigure(subsetEntry, xscrollcommand=function(...) tkset(subsetScroll, ...))
    newDataSetName <- tclVar(gettextRcmdr("<same as active data set>"))
    dataSetNameFrame <- tkframe(top)
    dataSetNameEntry <- ttkentry(dataSetNameFrame, width="25", textvariable=newDataSetName)
    onOK <- function(){
        newName <- trim.blanks(tclvalue(newDataSetName))
        if (newName == gettextRcmdr("<same as active data set>")) newName <- ActiveDataSet()
        if (!is.valid.name(newName)){
            errorCondition(recall=subsetDataSet,
                           message=paste('"', newName, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        if (is.element(newName, listDataSets())) {
            if ("no" == tclvalue(checkReplace(newName, type=gettextRcmdr("Data set")))){
                closeDialog()
                subsetDataSet()
                return()
            }
        }
        selectVars <- if (tclvalue(allVariables) == "1") ""
        else {
            x <- getSelection(variablesBox)
            if (0 == length(x)) {
                errorCondition(recall=subsetDataSet,
                               message=gettextRcmdr("No variables were selected."))
                return()
            }
            paste(", select=c(", paste(x, collapse=","), ")", sep="")
        }
        closeDialog()
        cases <- tclvalue(subsetVariable)
        selectCases <- if (cases == gettextRcmdr("<all cases>")) ""
        else paste(", subset=", cases, sep="")
        if (selectVars == "" && selectCases ==""){
            errorCondition(recall=subsetDataSet,
                           message=gettextRcmdr("New data set same as active data set."))
            return()
        }
        command <- paste(newName, " <- subset(", ActiveDataSet(), selectCases, selectVars, ")",
                         sep="")
        logger(command)
        result <- justDoIt(command)
        if (class(result)[1] !=  "try-error") activeDataSet(newName)
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="subset")
    tkgrid(allVariablesCheckBox, labelRcmdr(allVariablesFrame, text=gettextRcmdr("Include all variables")),
           sticky="w")
    tkgrid(allVariablesFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("   OR"), fg="red"), sticky="w")
    tkgrid(getFrame(variablesBox), sticky="nw")
    tkgrid(labelRcmdr(subsetFrame, text=gettextRcmdr("Subset expression")), sticky="w")
    tkgrid(subsetEntry, sticky="w")
    tkgrid(subsetScroll, sticky="ew")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(labelRcmdr(dataSetNameFrame, text=gettextRcmdr("Name for new data set")), sticky="w")
    tkgrid(dataSetNameEntry, sticky="w")
    tkgrid(dataSetNameFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix()
}

setCaseNames <- function(){
	dataSet <- activeDataSet()
	initializeDialog(title=gettextRcmdr("Set Case Names"))
	variablesBox <- variableListBox(top, Variables(), title=gettextRcmdr("Select variable containing row names"),
			initialSelection=NULL)
	onOK <- function(){
		variable <- getSelection(variablesBox)
		closeDialog()
		if (length(variable) == 0) {
			errorCondition(recall=setCaseNames, message=gettextRcmdr("You must select a variable."))
			return()
		}
		var <- eval(parse(text=paste(dataSet, "$", variable, sep="")), envir=.GlobalEnv)
		if (length(var) != length(unique(var))){
			errorCondition(recall=setCaseNames, message=gettextRcmdr("Case names must be unique."))
			return()
		}
		command <- paste("row.names(", dataSet, ") <- as.character(", dataSet, "$", variable, ")", sep="")
		result <- justDoIt(command)
		logger(command)
		eval(parse(text=paste(dataSet, "$", variable, "<- NULL", sep="")), envir=.GlobalEnv)
		logger(paste(dataSet, "$", variable, " <- NULL", sep=""))
		if (class(result)[1] !=  "try-error") activeDataSet(dataSet, flushModel=FALSE, flushDialogMemory=FALSE)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="row.names")
	tkgrid(getFrame(variablesBox), sticky="nw")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix()
}

renameVariables <- function(){
	initializeDialog(title=gettextRcmdr("Rename Variables"))
	variableBox <- variableListBox(top, Variables(), title=gettextRcmdr("Variables (pick one or more)"),
			selectmode="multiple", initialSelection=NULL)
	onOK <- function(){
		variables <- getSelection(variableBox)
		closeDialog()
		nvariables <- length(variables)
		if (nvariables < 1) {
			errorCondition(recall=renameVariables, message=gettextRcmdr("No variables selected."))
			return()
		}
		.activeDataSet <- ActiveDataSet()
		unordered.names <- names(get(.activeDataSet))
		which.variables <- match(variables, unordered.names)
		initializeDialog(subdialog, title=gettextRcmdr("Variable Names"))
		newnames <- rep("", nvariables)
		onOKsub <- function() {
			closeDialog(subdialog)
			for (i in 1:nvariables){
				newnames[i] <- eval(parse(text=paste("tclvalue(newName", i, ")", sep="")))
			}
			if (any(newnames == "")){
				errorCondition(recall=renameVariables, message=gettextRcmdr("A variable name is empty."))
				return()
			}
			test.names <- newnames == make.names(newnames)
			if (!all(test.names)){
				errorCondition(recall=renameVariables,
						message=paste(gettextRcmdr("The following variable names are not valid:\n"),
								paste(newnames[!test.names], collapse=", ")))
				return()
			}
			all.names <- names(get(.activeDataSet))
			all.names[which.variables] <- newnames
			if (length(unique(all.names)) != length(all.names)){
				errorCondition(recall=renameVariables, message=gettextRcmdr("Variable names are not unique"))
				return()
			}
			command <- paste("names(", .activeDataSet, ")[c(", paste(which.variables, collapse=","),
					")] <- c(", paste('"', newnames, '"', collapse=",", sep=""), ")", sep="")
			result <- justDoIt(command)
			logger(command)
			if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE, flushDialogMemory=FALSE)
			tkfocus(CommanderWindow())
		}
		subOKCancelHelp()
		tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Old Name"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"),
				labelRcmdr(subdialog, text=gettextRcmdr("New name"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
		for (i in 1:nvariables){
			valVar <- paste("newName", i, sep="")
			assign(valVar, tclVar(""))
			assign(paste("entry", i, sep=""), ttkentry(subdialog, width="20",
							textvariable=get(valVar)))
			tkgrid(labelRcmdr(subdialog, text=variables[i]), get(paste("entry", i, sep="")), sticky="w")
		}
		tkgrid(subButtonsFrame, sticky="w", columnspan=2)
		dialogSuffix(subdialog, focus=entry1, onOK=onOKsub, force.wait=TRUE)
	}
	OKCancelHelp(helpSubject="names")
	tkgrid(getFrame(variableBox), sticky="nw")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix()
}

setContrasts <- function(){
  initializeDialog(title=gettextRcmdr("Set Contrasts for Factor"))
  variableBox <- variableListBox(top, Factors(), title=gettextRcmdr("Factor (pick one)"))
  radioButtons(name="contrasts", buttons=c("treatment", "sum", "helmert", "poly", "specify"),
               values=c("contr.Treatment", "contr.Sum", "contr.helmert", "contr.poly", "specify"),
               labels=gettextRcmdr(c("Treatment (dummy) contrasts", "Sum (deviation) contrasts", "Helmert contrasts",
                                     "Polynomial contrasts", "Other (specify)")), title=gettextRcmdr("Contrasts"),
               columns=2)
  onOK <- function(){
    variable <- getSelection(variableBox)
    closeDialog()
    if (length(variable) == 0) {
      errorCondition(recall=setContrasts, message=gettextRcmdr("You must select a variable."))
      return()
    }
    contrasts <- tclvalue(contrastsVariable)
    if (contrasts != "specify"){
      command <- paste("contrasts(", ActiveDataSet(), "$", variable, ') <- "', contrasts, '"', sep="")
      result <- justDoIt(command)
      logger(command)
      if (class(result)[1] !=  "try-error") activeDataSet(ActiveDataSet())
      tkfocus(CommanderWindow())
    }
    else{
      initializeDialog(subdialog, title=gettextRcmdr("Specify Contrasts"))
      tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Enter Contrast Coefficients"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
      env <- environment()
      tableFrame <- tkframe(subdialog)
      row.names <- eval(parse(text=paste("levels(", ActiveDataSet(), "$", variable, ")")))
      row.names <- substring(paste(abbreviate(row.names, 12), "            "), 1, 12)
      nrows <- length(row.names)
      ncols <- nrows - 1
      make.col.names <- paste("labelRcmdr(tableFrame, text='", gettextRcmdr("Contrast Name:"), "')", sep="")
      for (j in 1:ncols) {
        varname <- paste(".col.", j, sep="")
        assign(varname, tclVar(paste(".", j, sep="")), envir=env)
        make.col.names <- paste(make.col.names, ", ",
                                "ttkentry(tableFrame, width='12', textvariable=", varname, ")", sep="")
      }
      eval(parse(text=paste("tkgrid(", make.col.names, ", sticky='w')", sep="")), envir=env)
      for (i in 1:nrows){
        make.row <- paste("labelRcmdr(tableFrame, text='", row.names[i], "')")
        for (j in 1:ncols){
          varname <- paste(".tab.", i, ".", j, sep="")
          assign(varname, tclVar("0"), envir=env)
          make.row <- paste(make.row, ", ", "ttkentry(tableFrame, width='5', textvariable=",
                            varname, ")", sep="")
        }
        eval(parse(text=paste("tkgrid(", make.row, ", sticky='w')", sep="")), envir=env)
      }
      tkgrid(tableFrame, sticky="w")
      onOKsub <- function(){
        closeDialog(subdialog)
        cell <- 0
        values <- rep(NA, nrows*ncols)
        for (j in 1:ncols){
          for (i in 1:nrows){
            cell <- cell + 1
            varname <- paste(".tab.", i, ".", j, sep="")
            values[cell] <- as.numeric(eval(parse(text=paste("tclvalue(", varname,")", sep=""))))
          }
        }
        values <- na.omit(values)
        if (length(values) != nrows*ncols){
          errorCondition(subdialog, recall=setContrasts,
                         message=sprintf(gettextRcmdr(
                           "Number of valid entries in contrast matrix(%d)\nnot equal to number of levels (%d) * number of contrasts (%d)."), length(values), nrows, ncols))
          return()
        }
        if (qr(matrix(values, nrows, ncols))$rank < ncols) {
          errorCondition(subdialog, recall=setContrasts, message=gettextRcmdr("Contrast matrix is not of full column rank"))
          return()
        }
        contrast.names <- rep("", ncols)
        for (j in 1:ncols){
          varname <- paste(".col.", j, sep="")
          contrast.names[j] <- eval(parse(text=paste("tclvalue(", varname,")", sep="")))
        }
        if (length(unique(contrast.names)) < ncols) {
          errorCondition(subdialog, recall=setContrasts, message=gettextRcmdr("Contrast names must be unique"))
          return()
        }
        command <- paste(".Contrasts <- matrix(c(", paste(values, collapse=","), "), ", nrows, ", ", ncols,
                         ")", sep="")
        doItAndPrint(command)
        command <- paste("colnames(.Contrasts) <- c(",
                         paste("'", contrast.names, "'", sep="", collapse=", "), ")", sep="")
        doItAndPrint(command)
        command <- paste("contrasts(", ActiveDataSet(), "$", variable, ") <- .Contrasts", sep="")
        result <- doItAndPrint(command)
        logger("remove(.Contrasts)")
        remove(.Contrasts, envir=.GlobalEnv)
        if (class(result)[1] !=  "try-error") activeDataSet(ActiveDataSet(), flushModel=FALSE, flushDialogMemory=FALSE)
        tkfocus(CommanderWindow())
      }
      subOKCancelHelp(helpSubject="contrasts")
      tkgrid(tableFrame, sticky="w")
      tkgrid(labelRcmdr(subdialog, text=""))
      tkgrid(subButtonsFrame, sticky="w")
      dialogSuffix(subdialog, focus=subdialog, force.wait=TRUE)
    }
  }
  OKCancelHelp(helpSubject="contrasts")
  tkgrid(getFrame(variableBox), sticky="nw")
  tkgrid(contrastsFrame, sticky="nw")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix()
}

refreshActiveDataSet <- function() activeDataSet(ActiveDataSet())

addObsNumbers <- function(){
	dsname <- ActiveDataSet()
	if (is.element("ObsNumber", listVariables())) {
		if ("no" == tclvalue(checkReplace("ObsNumber", gettextRcmdr("Variable")))){
			return()
		}
	}
	nrows <- nrow(get(dsname, envir=.GlobalEnv))
	command <- paste(dsname, "$ObsNumber <- 1:", nrows, sep="")
	logger(command)
	result <- justDoIt(command)
	if (class(result)[1] !=  "try-error") activeDataSet(dsname, flushModel=FALSE, flushDialogMemory=FALSE)
}

Stack <- function(){
	initializeDialog(title=gettextRcmdr("Stack Variables"))
	variableBox <- variableListBox(top, Numeric(), selectmode="multiple",
			title=gettextRcmdr("Variables (pick two or more)"))
	factorName <- tclVar("factor")
	factorNameField <- ttkentry(top, width="20", textvariable=factorName)
	variableName <- tclVar("variable")
	variableNameField <- ttkentry(top, width="20", textvariable=variableName)
	datasetName <- tclVar("StackedData")
	datasetNameField <- ttkentry(top, width="20", textvariable=datasetName)
	onOK <- function(){
		variables <- getSelection(variableBox)
		facname <- tclvalue(factorName)
		varname <- tclvalue(variableName)
		dsname <- tclvalue(datasetName)
		closeDialog()
		if (length(variables) < 2) {
			errorCondition(recall=Stack,
					message=gettextRcmdr("You must select at least two variables."))
			return()
		}
		if (!is.valid.name(facname)){
			errorCondition(recall=Stack,
					message=paste('"', facname, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (!is.valid.name(varname)){
			errorCondition(recall=Stack,
					message=paste('"', varname, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (!is.valid.name(dsname)){
			errorCondition(recall=Stack,
					message=paste('"', dsname, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsname, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsname, gettextRcmdr("Data set")))){
				Stack()
				return()
			}
		}
		command <- paste(dsname, " <- stack(", activeDataSet(), "[, c(",
				paste(paste('"', variables, '"', sep=""), collapse=","), ")])", sep="")
		logger(command)
		result <- justDoIt(command)
		command <- paste("names(", dsname, ') <- c("', varname, '", "', facname, '")',
				sep="")
		logger(command)
		justDoIt(command)
		if (class(result)[1] !=  "try-error") activeDataSet(dsname)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="stack")
	tkgrid(getFrame(variableBox), sticky="nw", columnspan=2)
	tkgrid(labelRcmdr(top, text=""))
	tkgrid(labelRcmdr(top,
					text=gettextRcmdr("Name for stacked data set:")), datasetNameField, sticky="w")
	tkgrid(labelRcmdr(top,
					text=gettextRcmdr("Name for variable:")), variableNameField, sticky="w")
	tkgrid(labelRcmdr(top,
					text=gettextRcmdr("Name for factor:")), factorNameField, sticky="w")
	tkgrid(buttonsFrame, sticky="w", columnspan=2)
	dialogSuffix(preventGrabFocus=TRUE)
}

loadDataSet <- function() {
	file <- tclvalue(tkgetOpenFile(filetypes=
							gettextRcmdr('{"All Files" {"*"}} {"R Data Files" {".RData" ".rda" ".Rda" ".RDA"}}')))
	if (file == "") return()
	setBusyCursor()
	on.exit(setIdleCursor())
	command <- paste('load("', file,'")', sep="")
	dsname <- justDoIt(command)
	logger(command)
	if (class(dsname)[1] !=  "try-error") {
	    if (length(dsname) > 1) {
	        Message(message=paste(gettextRcmdr("There is more than one object in the file, with the following names:\n"),
	                                     paste(dsname, collapse=", ")), type="error")
	        return()
	    }
	    activeDataSet(dsname)
	}
	tkfocus(CommanderWindow())
}

saveDataSet <- function() {
	file <- tclvalue(tkgetSaveFile(filetypes=
							gettextRcmdr('{"All Files" {"*"}} {"R Data Files" {".RData" ".rda" ".Rda" ".RDA"}}'),
					defaultextension=".RData", initialfile=paste(activeDataSet(), ".RData", sep="")))
	file <- removeRedundantExtension(file)
	if (file == "") return()
	file <- sub(".RData.RData$", ".RData", file)
	setBusyCursor()
	on.exit(setIdleCursor())
	command <- paste('save("', activeDataSet(), '", file="', file, '")', sep="")
	justDoIt(command)
	logger(command)
}


###
##  Copy this help to SelectRows when editing
###
#' @title Remove Rows from Active Data Set
#'
#' @keywords manip
#'
#' @usage NULL
#' 
#' @details
#' This menu option can be used to build a new data set by removing rows by name.
#'
#' In the "Indices or names of row(s) to select" field, enter the names of the rows you wish to keep, separated by spaces.
#' If a row name contains a space, it must be enclosed in single or double quotes.
#' In all other cases, quotes are not required.
#' You can also specify a name for the resulting data set in the "Name for new data set" field.
#' The new data set will automatically become the active data set.
#' 
#' If the data set has no associated row names, the original row indices are used as names.
#' Keep in mind that subsequent operations do not alter these row names; therefore, the numbers will always refer to the original row positions.
#'
#' This menu option produces a call to the \code{\link[base]{[.data.frame}} method from the \pkg{base} package.
#'
#' @seealso See also \code{\link{SelectRows}}.
RemoveRows <- function(){
  dataSet <- activeDataSet()
  initializeDialog(title=gettextRcmdr("Remove Rows from Active Data Set"))
  removeVariable <- tclVar(gettextRcmdr(""))
  removeFrame <- tkframe(top)
  removeEntry <- ttkentry(removeFrame, width="60", textvariable=removeVariable)
  removeScroll <- ttkscrollbar(removeFrame, orient="horizontal",
                               command=function(...) tkxview(removeEntry, ...))
  tkconfigure(removeEntry, xscrollcommand=function(...) tkset(removeScroll, ...))
  newDataSetName <- tclVar(gettextRcmdr("<same as active data set>"))
  dataSetNameFrame <- tkframe(top)
  dataSetNameEntry <- ttkentry(dataSetNameFrame, width="25", textvariable=newDataSetName)
  onOK <- function(){
    newName <- trim.blanks(tclvalue(newDataSetName))
    if (newName == gettextRcmdr("<same as active data set>")) newName <- ActiveDataSet()
    if (!is.valid.name(newName)){
      errorCondition(recall=RemoveRows,
                     message=paste('"', newName, '" ', gettextRcmdr("is not a valid name."), sep=""))
      return()
    }
    if (is.element(newName, listDataSets())) {
      if ("no" == tclvalue(checkReplace(newName, type=gettextRcmdr("Data set")))){
        closeDialog()
        RemoveRows()
        return()
      }
    }
    remove <- tclvalue(removeVariable)
    if (remove==""){
      errorCondition(recall=RemoveRows,
                     message="No rows to remove")
      closeDialog()
      return()
    }
    removeRows <- getCases(remove)
    if (inherits(removeRows, "cases-error")){
      errorCondition(recall = RemoveRows,
                     message = removeRows)
      closeDialog()
      return()
    }
    closeDialog()
    command <- paste(newName, " <- ", ActiveDataSet(), "[", removeRows, ",]", sep="")
    logger(command)
    result <- justDoIt(command)
    if (class(result)[1] !=  "try-error") activeDataSet(newName)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="RemoveRows")
  tkgrid(labelRcmdr(removeFrame, text=gettextRcmdr("Indices or names of row(s) to remove"),
                    foreground=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(removeEntry, sticky="w")
  tkgrid(removeScroll, sticky="ew")
  tkgrid(removeFrame, sticky="w")
  tkgrid(labelRcmdr(dataSetNameFrame, text=gettextRcmdr("Name for new data set")), sticky="w")
  tkgrid(dataSetNameEntry, sticky="w")
  tkgrid(dataSetNameFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix()
}


#' @title Select Rows from Active Data Set
#'
###
##  Copy this help from RemoveRows when editing
###
#' @keywords manip
#'
#' @usage NULL
#' 
#' @details
#' This menu option can be used to build a new data set by selecting rows by name.
#'
#' In the "Indices or names of row(s) to select" field, enter the names of the rows you wish to keep, separated by spaces.
#' If a row name contains a space, it must be enclosed in single or double quotes.
#' In all other cases, quotes are not required.
#' You can also specify a name for the resulting data set in the "Name for new data set" field.
#' The new data set will automatically become the active data set.
#' 
#' If the data set has no associated row names, the original row indices are used as names.
#' Keep in mind that subsequent operations do not alter these row names; therefore, the numbers will always refer to the original row positions.
#'
#' This menu option produces a call to the \code{\link[base]{[.data.frame}} method from the \pkg{base} package.
#'
#' @seealso See also \code{\link{RemoveRows}}.
SelectRows <- function(){
  dataSet <- activeDataSet()
  initializeDialog(title=gettextRcmdr("Select Rows from Active Data Set"))
  selectVariable <- tclVar(gettextRcmdr(""))
  selectFrame <- tkframe(top)
  selectEntry <- ttkentry(selectFrame, width="60", textvariable=selectVariable)
  selectScroll <- ttkscrollbar(selectFrame, orient="horizontal",
                               command=function(...) tkxview(selectEntry, ...))
  tkconfigure(selectEntry, xscrollcommand=function(...) tkset(selectScroll, ...))
  newDataSetName <- tclVar(gettextRcmdr("<same as active data set>"))
  dataSetNameFrame <- tkframe(top)
  dataSetNameEntry <- ttkentry(dataSetNameFrame, width="25", textvariable=newDataSetName)
  onOK <- function(){
    newName <- trim.blanks(tclvalue(newDataSetName))
    if (newName == gettextRcmdr("<same as active data set>")) newName <- ActiveDataSet()
    if (!is.valid.name(newName)){
      errorCondition(recall=SelectRows,
                     message=paste('"', newName, '" ', gettextRcmdr("is not a valid name."), sep=""))
      return()
    }
    if (is.element(newName, listDataSets())) {
      if ("no" == tclvalue(checkReplace(newName, type=gettextRcmdr("Data set")))){
        closeDialog()
        SelectRows()
        return()
      }
    }
    select <- tclvalue(selectVariable)
    if (select==""){
      errorCondition(recall=SelectRows, message="No rows to select")
      closeDialog()
      return()
    }
    selectRows <- getCases(select, remove=FALSE)
    if (inherits(selectRows, "cases-error")){
      errorCondition(recall = SelectRows,
                     message = selectRows)
      closeDialog()
      return()
    }
    closeDialog()
    command <- paste0(newName, " <- ", ActiveDataSet(), "[", selectRows, ", ")
    if (ncol(get(ActiveDataSet())) == 1) command <- paste0(command, ", drop = FALSE")
    command <- paste0(command, "]")
    logger(command)
    result <- justDoIt(command)
    if (class(result)[1] !=  "try-error") activeDataSet(newName)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="SelectRows")
  tkgrid(labelRcmdr(selectFrame, text=gettextRcmdr("Indices or names of row(s) to select"),
                    foreground=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(selectEntry, sticky="w")
  tkgrid(selectScroll, sticky="ew")
  tkgrid(selectFrame, sticky="w")
  tkgrid(labelRcmdr(dataSetNameFrame, text=gettextRcmdr("Name for new data set")), sticky="w")
  tkgrid(dataSetNameEntry, sticky="w")
  tkgrid(dataSetNameFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix()
}

mergeDataSets <- function(){
    dataSets <- listDataSets()
    .activeDataSet <- ActiveDataSet()
    initializeDialog(title=gettextRcmdr("Merge Data Sets"))
    dsname <- tclVar("MergedDataset")
    dsnameFrame <- tkframe(top)
    entryDsname <- ttkentry(dsnameFrame, width="20", textvariable=dsname)
    dataSet1Box <- variableListBox(top, dataSets, title=gettextRcmdr("First Data Set (pick one)"),
                                   initialSelection=if (is.null(.activeDataSet)) NULL else which(.activeDataSet == dataSets) - 1)
    dataSet2Box <- variableListBox(top, dataSets, title=gettextRcmdr("Second Data Set (pick one)"))
    commonVar <- tclVar("0")
    commonFrame <- tkframe(top)
    commonButton <- ttkcheckbutton(commonFrame, variable=commonVar)    
    radioButtons(top, "direction", buttons=c("rows", "columns"), 
                 labels=gettextRcmdr(c("Merge rows", "Merge columns")), title=gettextRcmdr("Direction of Merge"))
    onOK <- function(){
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=mergeDataSets,
                           message=gettextRcmdr("You must enter the name of a data set."))
            return()
        }
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=mergeDataSets,
                           message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                closeDialog()
                mergeDataSets()
                return()
            }
        }
        name1 <- getSelection(dataSet1Box)
        name2 <- getSelection(dataSet2Box)
        if (length(name1) == 0){
            errorCondition(recall=mergeDataSets,
                           message=gettextRcmdr("You must select a data set."))
            return()
        }
        if (length(name2) == 0){
            errorCondition(recall=mergeDataSets,
                           message=gettextRcmdr("You must select a data set."))
            return()
        }
        if (name1 == name2){
            errorCondition(recall=mergeDataSets,
                           message=gettextRcmdr("You cannot merge a data set with itself."))
            return()
        }
        common <- if (tclvalue(commonVar) == "1") TRUE else FALSE
        direction <- tclvalue(directionVariable)
        if (direction == "rows"){
            command <- paste(dsnameValue, " <- mergeRows(", name1, ", ", name2,
                             ", common.only=", common, ")", sep="")
            doItAndPrint(command)	
        }
        else {
            command <- paste(dsnameValue, " <- merge(", name1, ", ", name2,
                             ", all=", !common, ', by="row.names")', sep="")
            doItAndPrint(command)
            command <- paste("rownames(", dsnameValue, ") <- ", dsnameValue, "$Row.names", sep="")
            doItAndPrint(command)
            command <- paste(dsnameValue, "$Row.names <- NULL", sep="")
            doItAndPrint(command)
        }
        activeDataSet(dsnameValue)
        closeDialog()
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="mergeRows")
    tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Name for merged data set:  ")), entryDsname)
    tkgrid(dsnameFrame, sticky="w", columnspan=2)
    tkgrid(getFrame(dataSet1Box), getFrame(dataSet2Box), sticky="nw")
    tkgrid(commonButton, labelRcmdr(commonFrame, text=gettextRcmdr("Merge only common\nrows or columns")), 
           sticky="nw")
    tkgrid(directionFrame, commonFrame, sticky="sw")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    dialogSuffix()
}

Aggregate <- function(){
  .activeDataSet <- ActiveDataSet()
  initializeDialog(title=gettextRcmdr("Aggregate Observations"))
  dsname <- tclVar("AggregatedData")
  dsnameFrame <- tkframe(top)
  entryDsname <- ttkentry(dsnameFrame, width="20", textvariable=dsname)
  variablesBox <- variableListBox(top, Variables(), 
                                  title=gettextRcmdr("Variables to aggregate\n(pick one or more)"),
                                  selectmode="multiple")
  byBox <- variableListBox(top, Factors(), 
                           title=gettextRcmdr("Aggregate by\n(pick one or more)"),
                           selectmode="multiple")
  radioButtons(name="statistic", buttons=c("mean", "sum"), labels=gettextRcmdr(c("Mean", "Sum")), 
               title=gettextRcmdr("Statistic"))
  otherFrame <- tkframe(statisticFrame)
  otherVariable <- tclVar("")
  otherButton <- ttkradiobutton(otherFrame, variable=statisticVariable, value="other", 
                                text=gettextRcmdr("Other (specify)  "))
  otherEntry <- ttkentry(otherFrame, width="20", textvariable=otherVariable)   
  tkgrid(otherButton,  otherEntry, sticky="w")
  tkgrid(otherFrame, sticky="w")
  onOK <- function(){
    dsnameValue <- trim.blanks(tclvalue(dsname))
    if (dsnameValue == "") {
      errorCondition(recall=Aggregate,
                     message=gettextRcmdr("You must enter the name of a data set."))
      return()
    }
    if (!is.valid.name(dsnameValue)) {
      errorCondition(recall=Aggregate,
                     message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
      return()
    }
    if (is.element(dsnameValue, listDataSets())) {
      if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
        Aggregate()
        return()
      }
    }
    variables <- getSelection(variablesBox)
    byVariables <- getSelection(byBox)
    if (length(variables) == 0){
      errorCondition(recall=Aggregate,
                     message=gettextRcmdr("You must select at least one variable to aggregate."))
      return()
    }
    if (length(byVariables) == 0){
      errorCondition(recall=Aggregate,
                     message=gettextRcmdr("You must select at least one variable to aggregate by."))
      return()
    }
    if (any(byVariables %in% variables)){
      errorCondition(recall=Aggregate,
                     message=gettextRcmdr("Variables to aggregate and those to aggregate by must be different."))
      return()
    }
    statistic <- tclvalue(statisticVariable)
    if (statistic == "other") statistic <- tclvalue(otherVariable)
response <- if (length(variables) > 1) {
  paste("cbind(", paste(variables, collapse=", "), ")", sep="")
} else variables
rhs <- paste(byVariables, collapse=" + ")
command <- paste(dsnameValue, "<- aggregate(", response ," ~ ", rhs, ", data=", .activeDataSet, ", FUN=", 
                 statistic, ")", sep="")
doItAndPrint(command)
if (exists(dsnameValue) && is.data.frame(eval(parse(text=dsnameValue)))) activeDataSet(dsnameValue)
closeDialog()
tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="aggregate")
  tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Name for aggregated data set:  ")), entryDsname)
  tkgrid(dsnameFrame, sticky="w", columnspan=2)
  tkgrid(getFrame(variablesBox), getFrame(byBox), sticky="nw")
  tkgrid(statisticFrame, sticky="w", columnspan=2)
  tkgrid(buttonsFrame, sticky="w", columnspan=2)
  dialogSuffix()
}

#' @title Drop Unused Factor Levels
#'
#' @keywords manip
#'
#' @details
#' Following filtering or recoding procedures, certain factor levels may exhibit zero frequencies. This menu option allows users to remove such unobserved levels from the factor variable.
#'
#' This menu option calls the \code{\link[base:droplevels]{droplevles}} function from the \pkg{base} package.
#'
#' @usage NULL
#' 
dropUnusedFactorLevels <- function(){
    dataSet <- activeDataSet()
    initializeDialog(title=gettextRcmdr("Drop Unused Factor Levels"))
    allfactorsVariable <- tclVar("0")
    allFrame <- tkframe(top)
    allfactorsCheckBox <- ttkcheckbutton(allFrame, variable = allfactorsVariable)
    variablesBox <- variableListBox(top, Factors(),
        title=gettextRcmdr("Factors(s) to drop levels (pick one or more)"), selectmode="multiple",
        initialSelection=NULL)
    onOK <- function(){
        all <- tclvalue(allfactorsVariable)
        variables <- getSelection(variablesBox)
        closeDialog()
        if (all == 0 && length(variables) == 0) {
            errorCondition(recall=deleteVariable, message=gettextRcmdr("You must select one or more variables."))
            return()
        }
        response <- tclvalue(RcmdrTkmessageBox(message=gettextRcmdr("Drop unused factor levels\nPlease confirm."), 
            icon="warning", type="okcancel", default="cancel"))
        if (response == "cancel") {
            onCancel()
            return()
        }
        if (all == 1) command <- paste(dataSet, " <- droplevels(", dataSet, ")", sep="")
        else{
            command <- paste(dataSet, " <- within(", dataSet, ", {", sep="")
            for (variable in variables){
                command <- paste(command, "\n  ", variable, " <- droplevels(", variable, ")", sep="")
            }
            command <- paste(command, "\n})")
        }
        doItAndPrint(command)
        activeDataSet(dataSet, flushModel=FALSE, flushDialogMemory=FALSE)
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="dropUnusedFactorLevels")
    tkgrid(allfactorsCheckBox, labelRcmdr(allFrame, text=gettextRcmdr("all factors")), sticky="w")
    tkgrid(allFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("OR"), fg="red"), sticky="w")
    tkgrid(getFrame(variablesBox), sticky="nw")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix()
}

viewData <- function(){
    defaults <- list (initial.allVariables = "1", initial.variables = NULL, 
                      initial.subset=gettextRcmdr("<all cases>"))
    dialog.values <- getDialog ("viewData", defaults)
    dataSet <- activeDataSet()
    initializeDialog(title=gettextRcmdr("View Data"))
    allVariablesFrame <- tkframe(top)
    allVariables <- tclVar(dialog.values$initial.allVariables)
    allVariablesCheckBox <- ttkcheckbutton(allVariablesFrame, variable=allVariables)
    variablesBox <- variableListBox(top, Variables(), selectmode="multiple",
                                    initialSelection= varPosn (dialog.values$initial.variables), 
                                    title=gettextRcmdr("Variables (select one or more)"))
    subsetVariable <- tclVar(gettextRcmdr(dialog.values$initial.subset))
    subsetFrame <- tkframe(top)
    subsetEntry <- ttkentry(subsetFrame, width="20", textvariable=subsetVariable)
    subsetScroll <- ttkscrollbar(subsetFrame, orient="horizontal",
                                 command=function(...) tkxview(subsetEntry, ...))
    tkconfigure(subsetEntry, xscrollcommand=function(...) tkset(subsetScroll, ...))
    onOK <- function(){
        selectVars <- if (tclvalue(allVariables) == "1") {
            x <- ""
            x
        }
        else {
            x <- getSelection(variablesBox)
            if (0 == length(x)) {
                errorCondition(recall=viewData,
                               message=gettextRcmdr("No variables were selected."))
                return()
            }
            paste(", select=c(", paste(x, collapse=","), ")", sep="")
        }
        closeDialog()
        cases <- tclvalue(subsetVariable)
        selectCases <- if (cases == gettextRcmdr("<all cases>")) ""
        else paste(", subset=", cases, sep="")
        view.height <- max(getRcmdr("output.height") + getRcmdr("log.height"), 10)
        dim <- dim(get(ActiveDataSet()))
        nrows <- dim[1]
        ncols <- dim[2]
        threshold <- getRcmdr("showData.threshold")
        suppress <- if(getRcmdr("suppress.X11.warnings")) ", suppress.X11.warnings=FALSE" else ""
        result <- try(assign(dataSet, eval(parse(text=paste("subset(", dataSet, 
                                                      selectCases, selectVars, ")", sep="")))),
                      silent=TRUE)
        if (class(result)[1] ==  "try-error"){
            errorCondition(recall=viewData,
                           message=gettextRcmdr("Bad subset expression."))
            return()
        }
        if (nrows == 0){
            errorCondition(recall=viewData,
                           message=gettextRcmdr("No data to show."))
            return()
        }
        posn <- commanderPosition() + c(as.numeric(tkwinfo("width", CommanderWindow())) + 10, 10)
        command <- if (nrows <= threshold[1] && ncols <= threshold[2]){
            paste("showData(as.data.frame(", dataSet, "), title='", ActiveDataSet(), "', placement='+", posn[1], "+", posn[2],
                  "', font=getRcmdr('logFont'), maxwidth=",
                  getRcmdr("log.width"), ", maxheight=", view.height, suppress, ")", sep="")
        }
        else paste("View(as.data.frame(", dataSet, "))", sep="")
        result <- try(eval(parse(text=command)), silent=TRUE)
        if (class(result)[1] ==  "try-error"){
            errorCondition(recall=viewData,
                           message=gettextRcmdr("View data error."))
            return()
        }
        putDialog ("viewData", list(initial.allVariables = tclvalue(allVariables), 
                                    initial.variables = if (x[1] == "") NULL else x, initial.subset=cases))
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="showData", helpPackage="relimp", reset="viewData")
    tkgrid(allVariablesCheckBox, labelRcmdr(allVariablesFrame, text=gettextRcmdr("Include all variables")),
           sticky="w")
    tkgrid(allVariablesFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("   OR"), fg="red"), sticky="w")
    tkgrid(getFrame(variablesBox), sticky="nw")
    tkgrid(labelRcmdr(subsetFrame, text=gettextRcmdr("Subset expression")), sticky="w")
    tkgrid(subsetEntry, sticky="w")
    tkgrid(subsetScroll, sticky="ew")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix()
}

sortDataSet <- function(){
    dataSet <- activeDataSet()
    initializeDialog(title=gettextRcmdr("Sort Active Data Set"))
    variablesBox <- variableListBox(top, Variables(), selectmode="multiple",
                                    initialSelection=NULL, 
                                    title=gettextRcmdr("Sort Keys (select one or more)"))
    radioButtons(name="direction",
                 buttons=c("increasing", "decreasing"),
                 values=c("FALSE", "TRUE"),
                 labels=gettextRcmdr(c("Increasing", "Decreasing")), 
                 title=gettextRcmdr("Sort Direction"))
    newDataSetName <- tclVar(gettextRcmdr("<same as active data set>"))
    dataSetNameFrame <- tkframe(top)
    dataSetNameEntry <- ttkentry(dataSetNameFrame, width="25", textvariable=newDataSetName)
    onOK <- function(){
        newName <- trim.blanks(tclvalue(newDataSetName))
        if (newName == gettextRcmdr("<same as active data set>")) newName <- ActiveDataSet()
        if (!is.valid.name(newName)){
            errorCondition(recall=sortDataSet,
                           message=paste('"', newName, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
        }
        if (is.element(newName, listDataSets())) {
            if ("no" == tclvalue(checkReplace(newName, type=gettextRcmdr("Data set")))){
                closeDialog()
                sortDataSet()
                return()
            }
        }
        x <- getSelection(variablesBox)
        if (0 == length(x)) {
            errorCondition(recall=sortDataSet,
                           message=gettextRcmdr("No variables were selected."))
            return()
        }
        direction <- tclvalue(directionVariable)
        closeDialog()
        if (length(x) > 1){
            initializeDialog(subdialog, title=gettextRcmdr("Reorder Sort Keys"))
            nvalues <- length(x)
            order <- 1:nvalues
            onOKsub <- function() {
                closeDialog(subdialog)
                opt <- options(warn=-1)
                for (i in 1:nvalues){
                    order[i] <- as.numeric(eval(parse(text=paste("tclvalue(keyOrder", i, ")", sep=""))))
                }
                options(opt)
                if (any(sort(order) != 1:nvalues) || any(is.na(order))){
                    errorCondition(recall=sortDataSet,
                                   message=paste(gettextRcmdr("Order of keys must include all integers from 1 to "), 
                                                 nvalues, sep=""))
                    return()
                }
                x <- x[order(order)]
                doItAndPrint(paste(newName, " <- with(", dataSet, ", ", dataSet, "[order(", 
                                   paste(x, collapse=", "), ", decreasing=", direction, "), ])", sep=""))
                activeDataSet(newName)
            }
            subOKCancelHelp()
            tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Sort Keys"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"),
                   labelRcmdr(subdialog, text=gettextRcmdr("Order"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
            for (i in 1:length(x)){
                valVar <- paste("keyOrder", i, sep="")
                assign(valVar, tclVar(i))
                assign(paste("entry", i, sep=""), ttkentry(subdialog, width="2",
                                                           textvariable=get(valVar)))
                tkgrid(labelRcmdr(subdialog, text=x[i]), get(paste("entry", i, sep="")), sticky="w")
            }
            tkgrid(subButtonsFrame, sticky="w", columnspan=2)
            dialogSuffix(subdialog, focus=entry1, force.wait=TRUE)
        }
        else {
            doItAndPrint(paste(newName, " <- with(", dataSet, ", ", dataSet, "[order(", x, ", decreasing=", direction, "), ])", sep=""))
            activeDataSet(newName)
        }

        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="order")
    tkgrid(getFrame(variablesBox), sticky="nw")
    tkgrid(directionFrame, sticky="w")
    tkgrid(labelRcmdr(dataSetNameFrame, text=gettextRcmdr("Name for new data set")), sticky="w")
    tkgrid(dataSetNameEntry, sticky="w")
    tkgrid(dataSetNameFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix()
    }

#' @name ReshapeDatasetDialogs
#'
#' @aliases ReshapeDatasetDialogs reshapeLong2Wide reshapeWide2Long
#'
#' @title R Commander Reshape Data Set Dialogs
#'
#' @keywords manip
#' 
#' @author John Fox
#' 
#' @details
#' Reshape data sets between long and wide formats.
#' 
#' There are two dialogs for "reshaping" the active data set: (1) from "long" to "wide" format (using the \code{\link[RcmdrMisc]{reshapeL2W}} in the \pkg{RcmdrMisc} package); and (2) from "wide" to "long" format (using the \code{\link[RcmdrMisc]{reshapeW2L}} in the \pkg{RcmdrMisc} package).
#'
#' These dialogs are designed for handling regularly structured repeated-measures data, where each subject (independent unit of observation) is measured on several occasions or under several different conditions.
#' The occasions may have either a one-dimensional structure (corresponding to the levels of one repeated-measures or within-subjects factor) or a two-dimensional structure (corresponding to two crossed repeated-measures factors).
#'
#' Data in "wide" format have one row for each subject, with the repeated measures in different columns (variables).
#' Data in "long" format have several rows for each subject, with one column (variable) for the response; the levels of the repeated-measures factor (or combinations of levels for two repeated-measures factors) correspond to distinct rows.
#' The within-subjects factor or factors appear as different columns in the long data, as do the between-subjects factors; the former vary within subjects, while the latter are invariant within subjects; and an ID variable identifies the rows of the data set belonging to each subject.
#'
#' Data in wide format are suitable for analysis by the R Commander repeated-measures ANOVA/ANCOVA dialogs (see \code{\link{RepeatedMeasuresDialogs}}), while data in long format are suitable for analysis by the R Commander mixed-models dialogs.
#'
#' The \emph{Reshape Data Set from Long to Wide Format} dialog is largely self-explanatory: The user  selects the variable that identifies subjects (i.e., the ID variable); one or two within-subjects factors; the variable or variables that vary by occasion (there is typically just one, the response variable); and any variables in the long data set that are to be excluded from the wide data set.
#'
#' The \emph{Reshape Data Set from Wide to Long Format} dialog is more complex.
#' There are three tabs: A tab to specify one repeated-measures factor; a tab to specify two crossed repeated-measures factors; and an options tab.
#' The user specifies \emph{either} one \emph{or} two repeated-measures factors, not \emph{both}.
#' The within-subjects factor or factors are defined by using drop-down lists to select the variables that correspond to the levels of the within-subjects factor (in the case of one repeated-measures factor) or the combinations of levels of the within-subjects factors (in the case of two repeated-measures factors, organized as a two-way table).
#' The user can also name the levels of the within-subjects factor(s) and the factor or factors themselves.
#'
#' @seealso \code{\link[RcmdrMisc]{reshapeL2W}}, \code{\link[RcmdrMisc]{reshapeW2L}}, \code{\link{RepeatedMeasuresDialogs}}.
reshapeLong2Wide <- function () {
  defaults <- list(initial.id = NULL, initial.within=NULL, initial.varying=NULL, initial.ignore=NULL, initial.makeactive="1")
  dialog.values <- getDialog("reshapeLong2Wide", defaults)
  initializeDialog(title = gettextRcmdr("Reshape Data Set from Long to Wide Format"))
  .activeDataSet <- ActiveDataSet()
  optionsFrame <- tkframe(top)
  makeactiveVariable <- tclVar(dialog.values$initial.makeactive)
  makeactiveCheckBox <- ttkcheckbutton(optionsFrame, variable = makeactiveVariable)
  newDatasetName <- tclVar(paste0(.activeDataSet, "Wide"))
  newDatasetField <- ttkentry(optionsFrame, width = "20", 
                              textvariable = newDatasetName)
  dataFrame <- tkframe(top)
  idBox <- variableListBox(dataFrame, Variables(), title = gettextRcmdr("Subject ID variable (pick one)"),
                           initialSelection = varPosn(dialog.values$initial.id, "all"))
  withinBox <- variableListBox(dataFrame, Factors(), title = gettextRcmdr("Within-subjects factors (pick one or more)"),
                               initialSelection = varPosn(dialog.values$initial.within, "factor"), selectmode="multiple")
  varyingBox <- variableListBox(dataFrame, Variables(), title = gettextRcmdr("Variables that vary by occasion (pick one or more)"),
                                initialSelection = varPosn(dialog.values$initial.varying, "all"), selectmode="multiple")
  ignoreBox <- variableListBox(dataFrame, Variables(), title = gettextRcmdr("Variables to ignore (pick zero or more)"),
                               initialSelection = varPosn(dialog.values$initial.ignore, "all"), selectmode="multiple")
  onOK <- function() {
    id <- getSelection(idBox)
    within <- getSelection(withinBox)
    varying <- getSelection(varyingBox)
    ignore <- getSelection(ignoreBox)
    if (length(id) == 0) {
      errorCondition(recall = reshapeLong2Wide, message = gettextRcmdr("You must select an ID variable."))
      return()
    }
    if (length(within) == 0 ){
      errorCondition(recall = reshapeLong2Wide, message = gettextRcmdr("You must select one or more within-subjects factors."))
      return()
    }
    if (length(varying) == 0 ){
      errorCondition(recall = reshapeLong2Wide, message = gettextRcmdr("You must select one or more occasion-varying variables."))
      return()
    }
    all <- c(id, within, varying, ignore)
    duplicated <- unique(all[duplicated(all)])
    if (length(duplicated) > 0) {
      errorCondition(recall = reshapeLong2Wide, 
                     message = paste(gettextRcmdr("the following variables appear more than once:"), 
                                                  paste(duplicated, collapse=", ")))
      return()
    }
    makeactive <- tclvalue(makeactiveVariable)
    putDialog ("reshapeLong2Wide", list (initial.id = id, initial.within=within, 
                                         initial.varying=varying, initial.ignore=ignore,
                                         initial.makeactive=makeactive))
    newDatasetNameValue <- tclvalue(newDatasetName)
    if (newDatasetNameValue %in% listDataSets()){
      if ("no" == tclvalue(checkReplace(newDatasetNameValue, type=gettextRcmdr("Data set")))){
        errorCondition(recall = reshapeLong2Wide, message = gettextRcmdr("Save data set aborted"))
        return()
      }
    }
    closeDialog()
    within <- if (length(within) > 1) paste0("c(", paste(paste0('"', within, '"'), collapse=", "), ")") else paste0('"', within, '"')
    varying <-if (length(varying) > 1) paste0("c(", paste(paste0('"', varying, '"'), collapse=", "), ")") else paste0('"', varying, '"')
    ignore <-if (length(ignore) == 0) {
      NULL 
    } else if (length(ignore) > 1) {
      paste0(", ignore=c(", paste(paste0('"', ignore, '"'), collapse=", "), ")") 
    } else {
      paste0(', ignore="', ignore, '"')
    }
    id <- paste0('"', id, '"')
    doItAndPrint(paste0(newDatasetNameValue, " <- reshapeL2W(", .activeDataSet, 
                        ", within=", within, ", id=", id, ", varying=", varying, ignore, ")"))
    if (makeactive == "1") activeDataSet(newDatasetNameValue)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject = "ReshapeDatasetDialogs", reset = "reshapeLong2Wide")
  tkgrid(labelRcmdr(optionsFrame, text = gettextRcmdr("Name for wide data set: ")),
         newDatasetField, sticky="w")
  tkgrid(labelRcmdr(optionsFrame, text = gettextRcmdr("Make the wide data set active")),
         makeactiveCheckBox, sticky="w")
  tkgrid(optionsFrame, sticky="w")
  tkgrid(getFrame(idBox), labelRcmdr(dataFrame, text="  "), getFrame(withinBox), sticky = "nw")
  tkgrid(getFrame(varyingBox), labelRcmdr(dataFrame, text="  "), getFrame(ignoreBox),sticky = "nw")
  tkgrid(dataFrame, sticky="w")
  dialogSuffix(grid.buttons=TRUE)
}

reshapeWide2Long <- function () {
  checkResponses <- function(x){
    rows <- any(apply(x, 1, 
                      function(r){
                        if (!any(r)) FALSE else max(which(r)) > sum(r)
                      }
    ))
    cols <- any(apply(x, 2, 
                      function(c) {
                        if (!any(c)) FALSE else max(which(c)) > sum(c)
                      }
    ))
    test1 <- !(rows || cols)
    r <- sum(x[, 1])
    c <- sum(x[1, ])
    test2 <- all(x[r, c])
    test1 && test2
  }
  defaults <- list(initial.rm=matrix("", 5, 5), initial.rm.1=rep("", 8),
                   initial.level=paste0("Level-", 1:8),
                   initial.colLevel=paste0("Column-", 1:5),
                   initial.rowLevel=paste0("Row-", 1:5),
                   initial.wsrowfactorName="RowFactor",
                   initial.wscolfactorName="ColumnFactor",
                   initial.wsfactorName="trials", initial.tab=0,
                   initial.makeactive="1",
                   initial.ignore=NULL)
  dialog.values <- getDialog ("reshapeWide2Long", defaults)
  initializeDialog(title = gettextRcmdr("Reshape Data Set from Wide to Long Format"),
                   use.tabs=TRUE, tabs=c("oneFactorTab", "twoFactorsTab", "optionsTab"))
  
  .activeDataSet <- ActiveDataSet()
  makeactiveVariable <- tclVar(dialog.values$initial.makeactive)
  makeactiveCheckBox <- ttkcheckbutton(optionsTab, variable = makeactiveVariable)
  newDatasetName <- tclVar(paste0(.activeDataSet, "Long"))
  newDatasetField <- ttkentry(optionsTab, width = "20", textvariable = newDatasetName)
  idName <- tclVar("id")
  idField <- ttkentry(optionsTab, width = "20", textvariable = idName)
  responseName <- tclVar("response")
  responseField <- ttkentry(optionsTab, width = "20", textvariable = responseName)
  ignoreBox <- variableListBox(optionsTab, Variables(), title = gettextRcmdr("Variables to ignore (pick zero or more)"),
                               initialSelection = varPosn(dialog.values$initial.ignore, "all"), selectmode="multiple")
  onOK <- function() {
    tab <- if (as.character(tkselect(notebook)) == oneFactorTab$ID) 0 
    else if (as.character(tkselect(notebook)) == twoFactorsTab$ID) 1 
    else 2
    makeactive <- tclvalue(makeactiveVariable)
    ignoreValue <- getSelection(ignoreBox)
    ignore <-if (length(ignoreValue) == 0) {
      NULL 
    } else if (length(ignoreValue) > 1) {
      paste0(", ignore=c(", paste(paste0('"', ignoreValue, '"'), collapse=", "), ")") 
    } else {
      paste0(', ignore="', ignoreValue, '"')
    }
    id <- tclvalue(idName)
    response <- tclvalue(responseName)
    newDatasetNameValue <- tclvalue(newDatasetName)
    if (newDatasetNameValue %in% listDataSets()){
      if ("no" == tclvalue(checkReplace(newDatasetNameValue, type=gettextRcmdr("Data set")))){
        errorCondition(recall = reshapeWide2Long, message = gettextRcmdr("Save data set aborted"))
        return()
      }
    }
    rm1 <- getSelection(rm1ComboxBox)  
    rm2 <- getSelection(rm2ComboxBox)  
    rm3 <- getSelection(rm3ComboxBox)  
    rm4 <- getSelection(rm4ComboxBox)  
    rm5 <- getSelection(rm5ComboxBox)  
    rm6 <- getSelection(rm6ComboxBox) 
    rm7 <- getSelection(rm7ComboxBox)  
    rm8 <- getSelection(rm8ComboxBox)  
    responses.1 <- list(rm1, rm2, rm3, rm4, rm5, rm6, rm7, rm8)
    save.responses.1 <- unlist(responses.1)
    selected.1 <- !(responses.1 %in% c("", "<no selection>"))
    oneway <- any(selected.1)
    if (oneway && max(which(selected.1)) > sum(selected.1)){
      Message(gettextRcmdr("the specified responses are not contiguous\n missing responses are removed"), type="warning")
    }
    responses.1 <- lapply(responses.1, function(x) if (x %in% c("", gettextRcmdr("<no selection>"))) NULL else x)
    wsfactorName <- tclvalue(wsfactorNameVariable)
    if (oneway && !is.valid.name(wsfactorName)){
      errorCondition(recall=reshapeWide2Long, message=paste(wsfactorName, gettextRcmdr("is not a valid name")))
      return()
    }
    responses.1 <- unlist(responses.1)
    duplicates.1 <- duplicated(responses.1)
    if (oneway && any(duplicates.1)){
      errorCondition(recall=reshapeWide2Long, message=paste(gettextRcmdr("the following responses appear more than once:"),
                                                            paste(responses.1[duplicates.1], collapse=", ")))
      return()
    }
    m.1 <- length(responses.1)
    if (oneway && m.1 < 2){
      errorCondition(recall=reshapeWide2Long, message=gettextRcmdr("at least 2 responses must be specified"))
      return()
    }
    rm11 <- getSelection(rm11ComboxBox)  
    rm12 <- getSelection(rm12ComboxBox)  
    rm13 <- getSelection(rm13ComboxBox)  
    rm14 <- getSelection(rm14ComboxBox)  
    rm15 <- getSelection(rm15ComboxBox)  
    rm21 <- getSelection(rm21ComboxBox) 
    rm22 <- getSelection(rm22ComboxBox)  
    rm23 <- getSelection(rm23ComboxBox)  
    rm24 <- getSelection(rm24ComboxBox)  
    rm25 <- getSelection(rm25ComboxBox)  
    rm31 <- getSelection(rm31ComboxBox)  
    rm32 <- getSelection(rm32ComboxBox)  
    rm33 <- getSelection(rm33ComboxBox)  
    rm34 <- getSelection(rm34ComboxBox) 
    rm35 <- getSelection(rm35ComboxBox)  
    rm41 <- getSelection(rm41ComboxBox)  
    rm42 <- getSelection(rm42ComboxBox)  
    rm43 <- getSelection(rm43ComboxBox)  
    rm44 <- getSelection(rm44ComboxBox)  
    rm45 <- getSelection(rm45ComboxBox)  
    rm51 <- getSelection(rm51ComboxBox)  
    rm52 <- getSelection(rm52ComboxBox) 
    rm53 <- getSelection(rm53ComboxBox)  
    rm54 <- getSelection(rm54ComboxBox)
    rm55 <- getSelection(rm55ComboxBox)
    responses <- list(rm11, rm12, rm13, rm14, rm15, 
                      rm21, rm22, rm23, rm24, rm25,
                      rm31, rm32, rm33, rm34, rm35,
                      rm41, rm42, rm43, rm44, rm45,
                      rm51, rm52, rm53, rm54, rm55)
    responses <- matrix(responses, nrow=5, ncol=5, byrow=TRUE)
    selected <- !(responses %in% c("", gettextRcmdr("<no selection>")))
    if (oneway && any(selected)){
      errorCondition(recall=reshapeWide2Long,
                     message=gettextRcmdr("both one and two repeated-measures factors were specified\nspecify either a one-way or two-way design"))
      return()
    }
    selected <- matrix(selected, nrow=5, ncol=5)
    if (!oneway && !checkResponses(selected)){
      errorCondition(recall=reshapeWide2Long, message=gettextRcmdr("the specified responses are not contiguous"))
      return()
    }
    row1 <- selected[1, ]
    ncol <- if (any(row1)) max(which(row1)) else 0
    col1 <- selected[, 1]
    nrow <- if (any(col1)) max(which(col1)) else 0
    if (!oneway && ncol == 0){
      errorCondition(recall=reshapeWide2Long, message=gettextRcmdr("no responses specified"))
      return()
    }
    if (!oneway && (ncol < 2 || nrow < 2)){
      errorCondition(recall=reshapeWide2Long, message=gettextRcmdr("at least 2 rows and 2 columns of responses must be specified"))
      return()
    }
    responses <- as.vector(responses)
    save.responses <- unlist(responses)
    save.responses <- matrix(responses, 5, 5)
    responses <- responses[selected]
    wsrowfactorName <- tclvalue(wsrowfactorNameVariable)
    wscolfactorName <- tclvalue(wscolfactorNameVariable)
    if (!oneway && !is.valid.name(wsrowfactorName)){
      errorCondition(recall=reshapeWide2Long, message=paste(wsrowfactorName, gettextRcmdr("is not a valid name")))
      return()
    }
    if (!oneway && !is.valid.name(wscolfactorName)){
      errorCondition(recall=reshapeWide2Long, message=paste(wscolfactorName, gettextRcmdr("is not a valid name")))
      return()
    }
    level1 <- tclvalue(level1variable)
    level2 <- tclvalue(level2variable)
    level3 <- tclvalue(level3variable)
    level4 <- tclvalue(level4variable)
    level5 <- tclvalue(level5variable)
    level6 <- tclvalue(level6variable)
    level7 <- tclvalue(level7variable)
    level8 <- tclvalue(level8variable)
    levels <- c(level1, level2, level3, level4, level5, level6, level7, level8)[selected.1]
    nlevels <- length(levels)
    if(nlevels < 8) levels <- c(levels, paste0("Level-", as.character((nlevels + 1):8)))
    duplicated.levels <- duplicated(levels)
    if (oneway && any(duplicated(levels))){
      errorCondition(recall=reshapeWide2Long, 
                     message=paste0(gettextRcmdr("there are duplicated level names"), ":\n ", 
                                    paste(unique(levels[duplicated.levels]), collapse=", ")))
      return()
    }
    colLevel1 <- tclvalue(colLevel1variable)
    colLevel2 <- tclvalue(colLevel2variable)
    colLevel3 <- tclvalue(colLevel3variable)
    colLevel4 <- tclvalue(colLevel4variable)
    colLevel5 <- tclvalue(colLevel5variable)
    colLevels <- c(colLevel1, colLevel2, colLevel3, colLevel4, colLevel5)
    rowLevel1 <- tclvalue(rowLevel1variable)
    rowLevel2 <- tclvalue(rowLevel2variable)
    rowLevel3 <- tclvalue(rowLevel3variable)
    rowLevel4 <- tclvalue(rowLevel4variable)
    rowLevel5 <- tclvalue(rowLevel5variable)
    rowLevels <- c(rowLevel1, rowLevel2, rowLevel3, rowLevel4, rowLevel5)
    duplicated.levels <- duplicated(rowLevels)
    if (!oneway && any(duplicated(rowLevels))){
      errorCondition(recall=reshapeWide2Long, 
                     message=paste0(gettextRcmdr("there are duplicated row level names"), ":\n ", 
                                    paste(unique(rowLevels[duplicated.levels]), collapse=", ")))
      return()
    }    
    duplicated.levels <- duplicated(colLevels)
    if (!oneway && any(duplicated(colLevels))){
      errorCondition(recall=reshapeWide2Long, 
                     message=paste0(gettextRcmdr("there are duplicated column level names"), ":\n ", 
                                    paste(unique(colLevels[duplicated.levels]), collapse=", ")))
      return()
    }    
    putDialog ("reshapeWide2Long", list(initial.rm=save.responses, initial.tab=tab, 
                                        initial.wsrowfactorName=wsrowfactorName,
                                        initial.wscolfactorName=wscolfactorName,
                                        initial.rm.1=save.responses.1, initial.wsfactorName=wsfactorName,
                                        initial.level=levels, initial.rowLevel=rowLevels, initial.colLevel=colLevels,
                                        initial.makeactive=makeactive, initial.ignore=ignoreValue))
    responses <- unlist(responses)
    duplicates <- duplicated(responses)
    if (any(duplicates)){
      errorCondition(recall=reshapeWide2Long, message=paste(gettextRcmdr("the following responses appear more than once:"),
                                                            paste(responses[duplicates], collapse=", ")))
      return()
    }
    if (any(bad <- ignoreValue %in% c(responses, responses.1))){
      errorCondition(recall=reshapeWide2Long, message=paste(gettextRcmdr("the following ignored variables are also responses:"),
                                                            paste(ignoreValue[bad], collapse=", ")))
      return()
    }
    closeDialog()
    m <- length(responses)
    res <- if (m > 0) as.vector(t(matrix(responses, nrow, ncol)))
    command <- if (oneway){
      paste0(newDatasetNameValue,' <- reshapeW2L(', .activeDataSet, ', within="', wsfactorName, 
             '", levels=list(', wsfactorName, '=c(', paste(paste0('"', levels[1:m.1], '"'), collapse=", "), 
             ')), varying=list(', response, '=c(', paste(paste0('"', responses.1, '"'), collapse=', '),'))', ignore, ', id="', id, '")')
    } else {
      paste0(newDatasetNameValue,' <- reshapeW2L(', .activeDataSet, ', within=c("', wsrowfactorName, '", "', wscolfactorName, 
             '"), levels=list(', wsrowfactorName, '=c(', paste(paste0('"', rowLevels[1:nrow], '"'), collapse=", "), '), ', 
             wscolfactorName, '=c(', paste(paste0('"', colLevels[1:ncol], '"'), collapse=", "), ')), varying=list(',
             response, '=c(', paste(paste0('"', res, '"'), collapse=', '),'))', ignore, ', id="', id, '")')
    }
    doItAndPrint(command)
    if (makeactive == "1") activeDataSet(newDatasetNameValue)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject = "ReshapeDatasetDialogs", reset = "reshapeWide2Long")
  oneFactorFrame <- ttklabelframe(oneFactorTab, labelwidget=tklabel(top, text = gettextRcmdr("Specify one within-subject factor"),
                                                                    font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
  variableNameFrame.1 <- tkframe(oneFactorFrame)
  wsfactorNameVariable <- tclVar(dialog.values$initial.wsfactorName)
  wsfactorNameBox <-ttkentry(variableNameFrame.1, width="20", textvariable=wsfactorNameVariable)
  rm1ComboxBox <- variableComboBox(oneFactorFrame, variableList=Numeric(), 
                                   initialSelection=dialog.values$initial.rm.1[[1]], adjustWidth=TRUE,
                                   nullSelection=gettextRcmdr("<no selection>"))
  rm2ComboxBox <- variableComboBox(oneFactorFrame, variableList=Numeric(), 
                                   initialSelection=dialog.values$initial.rm.1[[2]], adjustWidth=TRUE,
                                   nullSelection=gettextRcmdr("<no selection>"))
  rm3ComboxBox <- variableComboBox(oneFactorFrame, variableList=Numeric(), 
                                   initialSelection=dialog.values$initial.rm.1[[3]], adjustWidth=TRUE,
                                   nullSelection=gettextRcmdr("<no selection>"))
  rm4ComboxBox <- variableComboBox(oneFactorFrame, variableList=Numeric(), 
                                   initialSelection=dialog.values$initial.rm.1[[4]], adjustWidth=TRUE,
                                   nullSelection=gettextRcmdr("<no selection>"))
  rm5ComboxBox <- variableComboBox(oneFactorFrame, variableList=Numeric(), 
                                   initialSelection=dialog.values$initial.rm.1[[5]], adjustWidth=TRUE,
                                   nullSelection=gettextRcmdr("<no selection>"))
  rm6ComboxBox <- variableComboBox(oneFactorFrame, variableList=Numeric(), 
                                   initialSelection=dialog.values$initial.rm.1[[6]], adjustWidth=TRUE,
                                   nullSelection=gettextRcmdr("<no selection>"))
  rm7ComboxBox <- variableComboBox(oneFactorFrame, variableList=Numeric(), 
                                   initialSelection=dialog.values$initial.rm.1[[7]], adjustWidth=TRUE,
                                   nullSelection=gettextRcmdr("<no selection>"))
  rm8ComboxBox <- variableComboBox(oneFactorFrame, variableList=Numeric(), 
                                   initialSelection=dialog.values$initial.rm.1[[8]], adjustWidth=TRUE,
                                   nullSelection=gettextRcmdr("<no selection>"))
  level1variable <- tclVar(dialog.values$initial.level[[1]])
  level1 <-ttkentry(oneFactorFrame, width="10", textvariable=level1variable, background="gray")
  level2variable <- tclVar(dialog.values$initial.level[[2]])
  level2 <-ttkentry(oneFactorFrame, width="10", textvariable=level2variable)
  level3variable <- tclVar(dialog.values$initial.level[[3]])
  level3 <-ttkentry(oneFactorFrame, width="10", textvariable=level3variable)
  level4variable <- tclVar(dialog.values$initial.level[[4]])
  level4 <-ttkentry(oneFactorFrame, width="10", textvariable=level4variable)
  level5variable <- tclVar(dialog.values$initial.level[[5]])
  level5 <-ttkentry(oneFactorFrame, width="10", textvariable=level5variable)
  level6variable <- tclVar(dialog.values$initial.level[[6]])
  level6 <-ttkentry(oneFactorFrame, width="10", textvariable=level6variable)
  level7variable <- tclVar(dialog.values$initial.level[[7]])
  level7 <-ttkentry(oneFactorFrame, width="10", textvariable=level7variable)
  level8variable <- tclVar(dialog.values$initial.level[[8]])
  level8 <-ttkentry(oneFactorFrame, width="10", textvariable=level8variable)
  tkgrid(labelRcmdr(variableNameFrame.1, text=gettextRcmdr("Name for the within-subjects factor: ")), wsfactorNameBox, sticky="w")
  tkgrid(variableNameFrame.1, sticky="w", columnspan=4)
  tkgrid(labelRcmdr(oneFactorFrame, text=gettextRcmdr("Specify up to 8 levels (responses) and level names for the within-subjects factor")), 
         sticky="w", columnspan=4)
  tkgrid(level1, level2, level3, level4, sticky="w")
  tkgrid(getFrame(rm1ComboxBox), getFrame(rm2ComboxBox), getFrame(rm3ComboxBox), getFrame(rm4ComboxBox), sticky="w")
  tkgrid(level5, level6, level7, level8, sticky="w")
  tkgrid(getFrame(rm5ComboxBox), getFrame(rm6ComboxBox), getFrame(rm7ComboxBox), getFrame(rm8ComboxBox), sticky="w")
  tkgrid(oneFactorFrame, sticky = "w")
  twoFactorsFrame <- ttklabelframe(twoFactorsTab, labelwidget=tklabel(top, text = gettextRcmdr("Specify two within-subject factors"),
                                                                      font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
  variableNameFrame <- tkframe(twoFactorsFrame)
  wsrowfactorNameVariable <- tclVar(dialog.values$initial.wsrowfactorName)
  wsrowfactorNameBox <-ttkentry(variableNameFrame, width="20", textvariable=wsrowfactorNameVariable)
  wscolfactorNameVariable <- tclVar(dialog.values$initial.wscolfactorName)
  wscolfactorNameBox <-ttkentry(variableNameFrame, width="20", textvariable=wscolfactorNameVariable)
  rm11ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), 
                                    initialSelection=dialog.values$initial.rm[[1, 1]], adjustWidth=TRUE,
                                    nullSelection=gettextRcmdr("<no selection>"))
  rm12ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), 
                                    initialSelection=dialog.values$initial.rm[[1, 2]], adjustWidth=TRUE,
                                    nullSelection=gettextRcmdr("<no selection>"))
  rm13ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), 
                                    initialSelection=dialog.values$initial.rm[[1, 3]], adjustWidth=TRUE,
                                    nullSelection=gettextRcmdr("<no selection>"))
  rm14ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), 
                                    initialSelection=dialog.values$initial.rm[[1, 4]], adjustWidth=TRUE,
                                    nullSelection=gettextRcmdr("<no selection>"))
  rm15ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), 
                                    initialSelection=dialog.values$initial.rm[[1, 5]], adjustWidth=TRUE,
                                    nullSelection=gettextRcmdr("<no selection>"))
  rm21ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[2, 1]], nullSelection=gettextRcmdr("<no selection>"))
  rm22ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[2, 2]], nullSelection=gettextRcmdr("<no selection>"))
  rm23ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[2, 3]], nullSelection=gettextRcmdr("<no selection>"))
  rm24ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[2, 4]], nullSelection=gettextRcmdr("<no selection>"))
  rm25ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[2, 5]], nullSelection=gettextRcmdr("<no selection>"))
  rm31ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[3, 1]], nullSelection=gettextRcmdr("<no selection>"))
  rm32ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[3, 2]], nullSelection=gettextRcmdr("<no selection>"))
  rm33ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[3, 3]], nullSelection=gettextRcmdr("<no selection>"))
  rm34ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[3, 4]], nullSelection=gettextRcmdr("<no selection>"))
  rm35ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[3, 5]], nullSelection=gettextRcmdr("<no selection>"))
  rm41ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[4, 1]], nullSelection=gettextRcmdr("<no selection>"))
  rm42ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[4, 2]], nullSelection=gettextRcmdr("<no selection>"))
  rm43ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[4, 3]], nullSelection=gettextRcmdr("<no selection>"))
  rm44ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[4, 4]], nullSelection=gettextRcmdr("<no selection>"))
  rm45ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[4, 5]], nullSelection=gettextRcmdr("<no selection>"))
  rm51ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[5, 1]], nullSelection=gettextRcmdr("<no selection>"))
  rm52ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[5, 2]], nullSelection=gettextRcmdr("<no selection>"))
  rm53ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[5, 3]], nullSelection=gettextRcmdr("<no selection>"))
  rm54ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[5, 4]], nullSelection=gettextRcmdr("<no selection>"))
  rm55ComboxBox <- variableComboBox(twoFactorsFrame, variableList=Numeric(), adjustWidth=TRUE,
                                    initialSelection=dialog.values$initial.rm[[5, 5]], nullSelection=gettextRcmdr("<no selection>"))
  colLevel1variable <- tclVar(dialog.values$initial.colLevel[[1]])
  colLevel1 <-ttkentry(twoFactorsFrame, width="10", textvariable=colLevel1variable, background="gray")
  colLevel2variable <- tclVar(dialog.values$initial.colLevel[[2]])
  colLevel2 <-ttkentry(twoFactorsFrame, width="10", textvariable=colLevel2variable)
  colLevel3variable <- tclVar(dialog.values$initial.colLevel[[3]])
  colLevel3 <-ttkentry(twoFactorsFrame, width="10", textvariable=colLevel3variable)
  colLevel4variable <- tclVar(dialog.values$initial.colLevel[[4]])
  colLevel4 <-ttkentry(twoFactorsFrame, width="10", textvariable=colLevel4variable)
  colLevel5variable <- tclVar(dialog.values$initial.colLevel[[5]])
  colLevel5 <-ttkentry(twoFactorsFrame, width="10", textvariable=colLevel5variable)
  rowLevel1variable <- tclVar(dialog.values$initial.rowLevel[[1]])
  rowLevel1 <-ttkentry(twoFactorsFrame, width="10", textvariable=rowLevel1variable, background="gray")
  rowLevel2variable <- tclVar(dialog.values$initial.rowLevel[[2]])
  rowLevel2 <-ttkentry(twoFactorsFrame, width="10", textvariable=rowLevel2variable)
  rowLevel3variable <- tclVar(dialog.values$initial.rowLevel[[3]])
  rowLevel3 <-ttkentry(twoFactorsFrame, width="10", textvariable=rowLevel3variable)
  rowLevel4variable <- tclVar(dialog.values$initial.rowLevel[[4]])
  rowLevel4 <-ttkentry(twoFactorsFrame, width="10", textvariable=rowLevel4variable)
  rowLevel5variable <- tclVar(dialog.values$initial.rowLevel[[5]])
  rowLevel5 <-ttkentry(twoFactorsFrame, width="10", textvariable=rowLevel5variable)
  tkgrid(labelRcmdr(variableNameFrame, text=gettextRcmdr("Name for the within-subjects row factor: ")), wsrowfactorNameBox, sticky="w")
  tkgrid(labelRcmdr(variableNameFrame, text=gettextRcmdr("Name for the within-subjects column factor: ")), wscolfactorNameBox, sticky="w")
  tkgrid(twoFactorsFrame, sticky="w")
  tkgrid(variableNameFrame, sticky="w", columnspan=4)
  tkgrid(labelRcmdr(twoFactorsFrame, text=gettextRcmdr("Specify up to 5 levels and level names for each within-subjects factor")), 
         sticky="w", columnspan=4)
  tkgrid(labelRcmdr(twoFactorsFrame, text=""), colLevel1, colLevel2, colLevel3, colLevel4, colLevel5, sticky="w")
  tkgrid(rowLevel1,
         getFrame(rm11ComboxBox), getFrame(rm12ComboxBox), getFrame(rm13ComboxBox), getFrame(rm14ComboxBox),  getFrame(rm15ComboxBox), sticky="sw")
  tkgrid(rowLevel2,
         getFrame(rm21ComboxBox), getFrame(rm22ComboxBox), getFrame(rm23ComboxBox), getFrame(rm24ComboxBox),  getFrame(rm25ComboxBox), sticky="sw")
  tkgrid(rowLevel3,
         getFrame(rm31ComboxBox), getFrame(rm32ComboxBox), getFrame(rm33ComboxBox), getFrame(rm34ComboxBox),  getFrame(rm35ComboxBox), sticky="sw")
  tkgrid(rowLevel4,
         getFrame(rm41ComboxBox), getFrame(rm42ComboxBox), getFrame(rm43ComboxBox), getFrame(rm44ComboxBox),  getFrame(rm45ComboxBox), sticky="sw")
  tkgrid(rowLevel5,
         getFrame(rm51ComboxBox), getFrame(rm52ComboxBox), getFrame(rm53ComboxBox), getFrame(rm54ComboxBox),  getFrame(rm55ComboxBox), sticky="sw")
  tkgrid(twoFactorsFrame, sticky = "w")
  
  tkgrid(labelRcmdr(optionsTab, text = gettextRcmdr("Name for long data set: ")),
         newDatasetField, sticky="w")
  tkgrid(labelRcmdr(optionsTab, text = gettextRcmdr("Response variable: ")),
         responseField, sticky="w")
  tkgrid(labelRcmdr(optionsTab, text = gettextRcmdr("Subject ID variable: ")),
         idField, sticky="w")
  tkgrid(labelRcmdr(optionsTab, text = gettextRcmdr("Make the wide data set active")),
         makeactiveCheckBox, sticky="w")
  tkgrid(getFrame(ignoreBox),sticky = "nw")
  dialogSuffix(use.tabs=TRUE, tabs=c("oneFactorTab", "twoFactorsTab", "optionsTab"),
               tab.names=c("One Repeated-Measures Factor", "Two Repeated-Measures Factors", "Options"), grid.buttons=TRUE)
}

characterToFactor <- function(){
  initializeDialog(title=gettextRcmdr("Convert Character Variables to Factors"))
  dataFrame <- tkframe(top)
  variableBox <- variableListBox(dataFrame, Character(), selectmode="multiple",
                                 title=gettextRcmdr("Variables (pick one or more)"))
  factorNameFrame <- tkframe(top)
  factorName <- tclVar(gettextRcmdr("<same as variables>"))
  factorNameField <- ttkentry(factorNameFrame, width="20", textvariable=factorName)
  onOK <- function(){
    variables <- getSelection(variableBox)
    closeDialog()
    facname <- trim.blanks(tclvalue(factorName))
    .activeDataSet <- ActiveDataSet()
    if (length(variables) == 0) {
      errorCondition(recall=characterToFactor, message=gettextRcmdr("You must select a variable."))}
    else command <- paste(.activeDataSet, " <- within(", .activeDataSet, ", {", sep="")
    for (name in variables){
      fname <- if (facname == gettextRcmdr("<same as variables>")) name
      else if (length(variables) == 1) facname
      else paste(facname, name, sep="")
      if (!is.valid.name(fname)){
        errorCondition(recall=characterToFactor,
                       message=paste('"', fname, '" ', gettextRcmdr("is not a valid name."), sep=""))
        return()
      }
      if (is.element(fname, Variables())) {
        if ("no" == tclvalue(checkReplace(fname))){
          characterToFactor()
          return()
        }
      }
      command <- paste(command, "\n  ", fname, " <- as.factor(", name, ")", sep="")
    }
    command <- paste(command, "\n})", sep="")
    result <- doItAndPrint(command)
    if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE, flushDialogMemory=FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="factor")
  tkgrid(getFrame(variableBox), labelRcmdr(dataFrame, text="  "), sticky="nw")
  tkgrid(dataFrame, sticky="w")
  tkgrid(labelRcmdr(factorNameFrame,
                    text=gettextRcmdr("New variable name or prefix for multiple variables:  ")),
         factorNameField, sticky="w")
  tkgrid(factorNameFrame, sticky="w")
  dialogSuffix(grid.buttons=TRUE)
}