# Graphs menu dialogs

# last modified 2022-06-30 by J. Fox

#  applied patch to improve window behaviour supplied by Milan Bouchet-Valat 2011-09-22

# the following functions improved by Miroslav Ristic 2013-07: barGraph, indexPlot, boxPlot, 
#    DensityPlot, Histogram, pieChart, PlotMeans, QQPlot, scatterPlot, scatterPlotMatrix, Stripchart,
#    Xyplot

indexPlot <- function () {
    defaults <- list(initial.x = NULL, initial.type = "spikes", initial.identify = "auto",
                     initial.id.n="2", initial.tab=0, 
                     initial.ylab=gettextRcmdr("<auto>"), initial.main=gettextRcmdr("<auto>"), initial.group = NULL)
    dialog.values <- getDialog("indexPlot", defaults)
    initial.group <- dialog.values$initial.group
    .groups <- if (is.null(initial.group)) FALSE else initial.group
    initializeDialog(title = gettextRcmdr("Index Plot"), use.tabs=TRUE)
    xBox <- variableListBox(dataTab, Numeric(), title = gettextRcmdr("Variable (pick one or more)"), 
                            selectmode = "multiple", initialSelection = varPosn (dialog.values$initial.x, "numeric"))
    optionsFrame <- tkframe(optionsTab)    
    optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Options"),
                                                                font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
                                                                font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    typeVariable <- tclVar(dialog.values$initial.type)
    styleFrame <- tkframe(optFrame)
    radioButtons(styleFrame, name = "type", buttons = c("spikes", "points"),
                 labels = gettextRcmdr(c("Spikes", "Points")), title = gettextRcmdr("Style of plot"),
                 initialValue = dialog.values$initial.type)
    identifyPointsFrame <- tkframe(optFrame)
    radioButtons(identifyPointsFrame, name = "identify", buttons = c("auto", "mouse", 
                                                                     "not"), labels = gettextRcmdr(c("Automatically", 
                                                                                                     "Interactively with mouse", "Do not identify")), title = gettextRcmdr("Identify Points"), 
                 initialValue = dialog.values$initial.identify)    
    id.n.Var <- tclVar(dialog.values$initial.id.n) 
    npointsSpinner <- tkspinbox(identifyPointsFrame, from=1, to=10, width=2, textvariable=id.n.Var)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        x <- getSelection(xBox)
        identify <- tclvalue(identifyVariable)
        id.n <- tclvalue(id.n.Var)
        if (is.na(suppressWarnings(as.numeric(id.n))) || round(as.numeric(id.n)) != as.numeric(id.n)){
            errorCondition(recall = indexPlot, message = gettextRcmdr("number of points to identify must be an integer"))
            return()
        }
        ylab <- trim.blanks(tclvalue(ylabVar))
        ylab <- if (ylab == gettextRcmdr("<auto>"))
            ""
        else paste(", ylab=\"", ylab, "\"", sep = "")
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            ""
        else paste(", main=\"", main, "\"", sep = "")
        closeDialog()
        n.x <- length(x)
        if (n.x == 0) {
            errorCondition(recall = indexPlot, message = gettextRcmdr("You must select a variable"))
            return()
        }
        if (n.x > 5){
            response <- RcmdrTkmessageBox(message=sprintf(gettextRcmdr("You have selected %d variables.\nDo you want to proceed?"), n.x),
                                          icon="question", type="okcancel", default="cancel")
            if ("cancel" == tclvalue(response)) {
                tkfocus(CommanderWindow())
                return()
            }
        }
        putDialog ("indexPlot", list(initial.x = x, initial.type = tclvalue(typeVariable), initial.identify = identify,
                                     initial.id.n = id.n, initial.tab=tab,
                                     initial.ylab = tclvalue(ylabVar), initial.main = tclvalue(mainVar),
                                     initial.group=if (.groups == FALSE) NULL else .groups))
        type <- if (tclvalue(typeVariable) == "spikes") "h" else "p"
        method <- if (identify == "mouse") "identify" else "y"
        id.n.use <- if (identify == "not") 0 else id.n
        .activeDataSet <- ActiveDataSet()
        if (identify == "mouse") {
            RcmdrTkmessageBox(title = "Identify Points", message = paste(gettextRcmdr("Use left mouse button to identify points,\n"), 
                                                                         gettextRcmdr(if (MacOSXP()) 
                                                                             "esc key to exit."
                                                                             else "right button to exit."), sep = ""), icon = "info", 
                              type = "ok")
        }
        x <- if (n.x == 1) paste0("'", x, "'")
        else paste0("c(", paste(paste0("'", x, "'"), collapse=", "), ")")
        command <- if (is.null(.groups) || .groups == FALSE) {
            paste0("indexplot(", .activeDataSet, "[,", x, ", drop=FALSE], type='", type,
                   "', id.method='", method, "', id.n=", id.n.use,
                   ylab, main, ")") 
        } else {
            paste0("indexplot(", .activeDataSet, "[,", x, ", drop=FALSE], type='", type,
                   "', id.method='", method, "', id.n=", id.n.use,
                   ylab, main, ", groups=", .activeDataSet, "$", .groups, ")") 
        }
        if (identify == "mouse") command <- suppressMarkdown(command)
        doItAndPrint(command)
        activateMenus()
        tkfocus(CommanderWindow())
    }
    groupsBox(indexPlot, initialGroup=initial.group,
              initialLabel=if (is.null(initial.group)) gettextRcmdr("Mark by groups")
              else paste(gettextRcmdr("Mark by:"), initial.group), window=dataTab)
    OKCancelHelp(helpSubject = "indexplot", reset = "indexPlot", apply="indexPlot")
    tkgrid(getFrame(xBox), sticky = "nw")
    tkgrid(groupsFrame, sticky = "w")
    tkgrid(typeFrame, sticky = "w")
    tkgrid(styleFrame, sticky = "w")
    tkgrid(identifyFrame, sticky="w")
    tkgrid(labelRcmdr(identifyPointsFrame, text=gettextRcmdr("Number of points to identify  ")), npointsSpinner, sticky="w")
    tkgrid(identifyPointsFrame, sticky="w")
    tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
    tkgrid(optionsFrame, sticky = "w")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

Histogram <- function () {
    defaults <- list(initial.x = NULL, initial.scale = "frequency",
        initial.bins = gettextRcmdr ("<auto>"), initial.tab=0,
        initial.xlab=gettextRcmdr("<auto>"), initial.ylab=gettextRcmdr("<auto>"),
        initial.main=gettextRcmdr("<auto>"), initial.group = NULL)
    dialog.values <- getDialog("Histogram", defaults)
    initializeDialog(title = gettextRcmdr("Histogram"), use.tabs=TRUE)
    xBox <- variableListBox(dataTab, Numeric(), title = gettextRcmdr("Variable (pick one)"),
        initialSelection = varPosn (dialog.values$initial.x, "numeric"))
    initial.group <- dialog.values$initial.group
    .groups <- if (is.null(initial.group)) FALSE else initial.group
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        x <- getSelection(xBox)
        closeDialog()
        if (length(x) == 0) {
            errorCondition(recall = Histogram, message = gettextRcmdr("You must select a variable"))
            return()
        }
        bins <- tclvalue(binsVariable)
        opts <- options(warn = -1)
        binstext <- if (bins == gettextRcmdr("<auto>"))
            "\"Sturges\""
        else as.numeric(bins)
        options(opts)
        scale <- tclvalue(scaleVariable)
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if (xlab == gettextRcmdr("<auto>"))
            ""
        else paste(", xlab=\"", xlab, "\"", sep = "")
        ylab <- trim.blanks(tclvalue(ylabVar))
        ylab <- if (ylab == gettextRcmdr("<auto>"))
            ""
        else paste(", ylab=\"", ylab, "\"", sep = "")
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            ""
        else paste(", main=\"", main, "\"", sep = "")
        putDialog ("Histogram", list (initial.x = x, initial.bins = bins, initial.scale = scale,
            initial.tab=tab, initial.xlab=tclvalue(xlabVar), initial.ylab = tclvalue(ylabVar),
            initial.main = tclvalue(mainVar), initial.group=if (.groups == FALSE) NULL else .groups))
        if (is.null(.groups) || .groups == FALSE) {
            command <- paste("with(", ActiveDataSet(), ", Hist(", x, ', scale="', scale, '", breaks=',
                binstext, ', col="darkgray"', xlab, ylab, main, "))", sep="")
        }
        else{
            command <- paste("with(", ActiveDataSet(), ", Hist(", x, ", groups=", .groups, ', scale="',
                scale, '", breaks=', binstext, ', col="darkgray"', xlab, ylab, main, "))", sep="")
        }
        doItAndPrint(command)
        insertRmdSection(paste0(gettextRmdHeader("Histogram: "), x))
        activateMenus()
        tkfocus(CommanderWindow())
    }
    groupsBox(Histogram, initialGroup=initial.group,
        initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups")
        else paste(gettextRcmdr("Plot by:"), initial.group), window=dataTab)
    OKCancelHelp(helpSubject = "Hist", reset = "Histogram", apply="Histogram")
    optionsFrame <- tkframe(optionsTab)
    optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Options"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    xlabVar <- tclVar(dialog.values$initial.xlab)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    axisFrame <- tkframe(optFrame)
    radioButtons(axisFrame, name = "scale", buttons = c("frequency", "percent",
        "density"), labels = gettextRcmdr(c("Frequency counts",
            "Percentages", "Densities")), title = gettextRcmdr("Axis Scaling"),
        initialValue = dialog.values$initial.scale)
    binsFrame <- tkframe(optFrame)
    binsVariable <- tclVar(dialog.values$initial.bins)
    binsField <- ttkentry(binsFrame, width = "8", textvariable = binsVariable)
    tkgrid(getFrame(xBox), sticky = "nw")
    tkgrid(groupsFrame, sticky = "w")
    tkgrid(labelRcmdr(binsFrame, text = gettextRcmdr("Number of bins: ")),
        binsField, sticky = "w")
    tkgrid(binsFrame, sticky = "w")
    tkgrid(scaleFrame, sticky = "w")
    tkgrid(axisFrame, sticky = "w")
    tkgrid.configure(binsField, sticky = "e")
    tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
    tkgrid(optionsFrame, sticky = "w")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

stemAndLeaf <- function () {
    Library("aplpack")
    defaults <- list(initial.x = NULL, initial.leafs.auto="1", initial.unit = 0,  initial.m = "auto", 
        initial.trim = 1, initial.depths = 1, initial.reverse = 1, initial.style = "Tukey",
        initial.tab=0, initial.group = NULL) 
    dialog.values <- getDialog("stemAndLeaf", defaults)
    initializeDialog(title = gettextRcmdr("Stem and Leaf Display"), 
        #                     preventCrisp = TRUE, use.tabs=TRUE)
        use.tabs=TRUE)
    initial.group <- dialog.values$initial.group
    .groups <- if (is.null(initial.group)) FALSE else initial.group
    xBox <- variableListBox(dataTab, Numeric(), title = gettextRcmdr("Variable (pick one)"), 
        initialSelection = varPosn (dialog.values$initial.x, "numeric"))
    displayDigits <- tclVar(formatC(10^dialog.values$initial.unit))
    leafsDigitValue <- tclVar(dialog.values$initial.unit)
    leafsDigitOnce <- TRUE
    onDigits <- function(...) {
        if(leafsDigitOnce) {
            leafsDigitOnce <<- FALSE
            return()
        }
        
        tclvalue(displayDigits) <- formatC(10^as.numeric(tclvalue(leafsDigitValue)), 
            format = "fg", big.mark = ",")
        tclvalue(leafsAutoVariable) <- "0"
    }
    radioButtons(optionsTab, name = "parts", buttons = c("auto", "one", "two", 
        "five"), values = c("auto", "1", "2", "5"), labels = c(gettextRcmdr("Automatic"), 
            "   1", "   2", "   5"), title = gettextRcmdr("Parts Per Stem"), 
        initialValue = dialog.values$initial.m)
    radioButtons(optionsTab, name = "style", buttons = c("Tukey", "bare"), 
        labels = gettextRcmdr(c("Tukey", "Repeated stem digits")), 
        title = gettextRcmdr("Style of Divided Stems"), 
        initialValue = dialog.values$initial.style)
    checkBoxes(optionsTab, frame="otherOptionsFrame", 
        boxes = c("trimOutliers", "showDepths", "reverseNegative"), 
        initialValues = c(dialog.values$initial.trim, dialog.values$initial.depths, dialog.values$initial.reverse),
        labels = gettextRcmdr(c("Trim outliers", "Show depths", "Reverse negative leaves")),
        title=gettextRcmdr("Other Options"))
    leafsFrame <- tkframe(optionsTab)
    leafsDigitValue <- tclVar(dialog.values$initial.unit)
    leafsDigitSlider <- tkscale(leafsFrame, from = -6, to = 6, 
        showvalue = FALSE, variable = leafsDigitValue, resolution = 1, 
        orient = "horizontal", command = onDigits)
    leafsDigitShow <- labelRcmdr(leafsFrame, textvariable = displayDigits, 
        width = 8, justify = "right")
    leafsAutoVariable <- tclVar(dialog.values$initial.leafs.auto)
    leafsDigitCheckBox <- ttkcheckbutton(leafsFrame, text = gettextRcmdr("Automatic"),
        variable = leafsAutoVariable)
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        x <- getSelection(xBox)
        m <- tclvalue(partsVariable)
        style <- tclvalue (styleVariable)
        trim <- tclvalue (trimOutliersVariable)
        depths <- tclvalue (showDepthsVariable)
        reverse <- tclvalue (reverseNegativeVariable)
        unit <- if (tclvalue(leafsAutoVariable) == "1") 
            ""
        else paste(", unit=", 10^as.numeric(tclvalue(leafsDigitValue)), 
            sep = "")
        putDialog ("stemAndLeaf", list(initial.x = x, initial.leafs.auto=tclvalue(leafsAutoVariable),
            initial.unit = as.numeric(tclvalue(leafsDigitValue)),  initial.m = m, 
            initial.trim = trim, initial.depths = depths, initial.reverse = reverse, 
            initial.style = style, initial.tab=tab,
            initial.group=if (.groups == FALSE) NULL else .groups))
        closeDialog()
        if (length(x) == 0) {
            errorCondition(recall = stemAndLeaf, message = gettextRcmdr("You must select a variable"))
            return()
        }
        trim <- if (tclvalue(trimOutliersVariable) == "1") 
            ""
        else ", trim.outliers=FALSE"
        depths <- if (tclvalue(showDepthsVariable) == "1") 
            ""
        else ", depths=FALSE"
        reverse <- if (tclvalue(reverseNegativeVariable) == "1") 
            ""
        else ", reverse.negative.leaves=FALSE"
        m <- if (tclvalue(partsVariable) == "auto") 
            ""
        else paste(", m=", tclvalue(partsVariable), sep = "")
        style <- if (tclvalue(styleVariable) == "Tukey") 
            ""
        else ", style=\"bare\""
        command <- if (is.null(.groups) || .groups == FALSE){
            paste("with(", ActiveDataSet(), ", stem.leaf(",  
                x, style, unit, m, trim, depths, reverse, ", na.rm=TRUE))", 
                sep = "")
        } else {
            levels <- levels(eval(parse(text=paste(ActiveDataSet(), "$", .groups, sep="")), 
                envir=.GlobalEnv))
            paste("with(", ActiveDataSet(),
                ", stem.leaf.backback(", x,"[", .groups, ' == "', levels[1], '"], ',
                x,"[", .groups, ' == "', levels[2], '"]',
                style, unit, m, trim, depths, reverse, ", na.rm=TRUE))", 
                sep = "")
        }
        doItAndPrint(command)
        insertRmdSection(paste0(gettextRmdHeader("Stem-and-Leaf Display: "), x))
        tkfocus(CommanderWindow())
    }
    groupsBox(stemAndLeaf, variables=TwoLevelFactors(), initialGroup=initial.group,
        label=gettextRcmdr("Plot back-to-back by:"),
        initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot back-to-back by")
        else paste(gettextRcmdr("Plot back-to-back by:"), initial.group), 
        errorText=gettextRcmdr("There are no two-level factors in the active data set."), 
        window=dataTab)
    OKCancelHelp(helpSubject = "stem.leaf", reset = "stemAndLeaf", apply = "stemAndLeaf")
    tkgrid(getFrame(xBox), sticky = "nw")
    tkgrid(labelRcmdr(leafsFrame, text = gettextRcmdr("Leafs Digit:  "), 
        fg = getRcmdr("title.color"), font="RcmdrTitleFont"), leafsDigitCheckBox, 
        labelRcmdr(leafsFrame, text = gettextRcmdr("  or set:"), 
            fg = "red"), leafsDigitShow, leafsDigitSlider, sticky = "w")
    tkgrid(partsFrame, sticky = "w")
    tkgrid(styleFrame, sticky = "w")
    tkgrid(otherOptionsFrame, sticky="w")
    tkgrid(leafsFrame, sticky = "w")
    tkgrid(groupsFrame, sticky = "w")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

boxPlot <- function () {
  defaults <- list(initial.x = NULL, initial.identify = "y", initial.group=NULL,
                   initial.xlab=gettextRcmdr("<auto>"), initial.ylab=gettextRcmdr("<auto>"), 
                   initial.main=gettextRcmdr("<auto>"), initial.tab=0)
  dialog.values <- getDialog("boxPlot", defaults)
  initializeDialog(title = gettextRcmdr("Boxplot"), use.tabs=TRUE)
  xBox <- variableListBox(dataTab, Numeric(), selectmode = "multiple",
                          title = gettextRcmdr("Variable (pick one or more)"),
                          initialSelection = varPosn (dialog.values$initial.x, "numeric"))
  optionsFrame <- tkframe(optionsTab)
  optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Identify Outliers"),
                                                              font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
  parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
                                                              font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
  styleFrame <- tkframe(optFrame)
  radioButtons(optFrame, name = "identify", buttons = c("y", "identify", "none"),
               labels = gettextRcmdr(c("Automatically", "With mouse", "No")),
               initialValue = dialog.values$initial.identify, )
  initial.group <- dialog.values$initial.group
  .groups <- if (is.null(initial.group)) FALSE else initial.group
  xlabVar <- tclVar(dialog.values$initial.xlab)
  ylabVar <- tclVar(dialog.values$initial.ylab)
  mainVar <- tclVar(dialog.values$initial.main)
  xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
  xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                             command = function(...) tkxview(xlabEntry, ...))
  tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
                                                              ...))
  tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
  tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
  ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
  ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                             command = function(...) tkxview(ylabEntry, ...))
  tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
                                                              ...))
  tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
  tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
  mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
  mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                             command = function(...) tkxview(mainEntry, ...))
  tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
                                                              ...))
  tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
  tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
  onOK <- function() {
    tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
    x <- getSelection(xBox)
    identifyPoints <- tclvalue(identifyVariable)
    xlab <- trim.blanks(tclvalue(xlabVar))
    xlab <- if (xlab == gettextRcmdr("<auto>"))
      ""
    else paste(", xlab=\"", xlab, "\"", sep = "")
    ylab <- trim.blanks(tclvalue(ylabVar))
    ylab <- if (ylab == gettextRcmdr("<auto>"))
      ""
    else paste(", ylab=\"", ylab, "\"", sep = "")
    main <- trim.blanks(tclvalue(mainVar))
    main <- if (main == gettextRcmdr("<auto>"))
      ""
    else paste(", main=\"", main, "\"", sep = "")
    putDialog ("boxPlot", list(initial.x = x, initial.identify = identifyPoints,
                               initial.group=if (.groups == FALSE) NULL else .groups,
                               initial.xlab=tclvalue(xlabVar), initial.ylab=tclvalue(ylabVar),
                               initial.main=tclvalue(mainVar), initial.tab=tab))
    closeDialog()
    if (length(x) == 0) {
      errorCondition(recall = boxPlot, message = gettextRcmdr("You must select a variable"))
      return()
    }
    .activeDataSet <- ActiveDataSet()
#    var <- paste(.activeDataSet, "$", x, sep = "")
    if (identifyPoints == "identify")
      RcmdrTkmessageBox(title = "Identify Points",
                        message = paste(gettextRcmdr("Use left mouse button to identify points,\n"),
                                        gettextRcmdr(if (MacOSXP()) "esc key to exit."
                                                     else "right button to exit."), sep = ""),
                        icon = "info", type = "ok")
    if (is.null(.groups) || .groups == FALSE) {
      command <- paste("Boxplot( ~ ", paste(x, collapse=" + "), ", data=", .activeDataSet, ', id=list(method="',
                       identifyPoints, '")', ylab, main, ')', sep="")
      if (identifyPoints == "identify") command <- suppressMarkdown(command)
      
      doItAndPrint(command)
    }
    else {
      if (length(x) > 1) {
        errorCondition(recall = boxPlot, 
                       message = gettextRcmdr("You cannot plot by groups with more than one variable selected"))
        return()
      }
      command <- paste("Boxplot(", x, " ~ ", .groups, ", data=", .activeDataSet,
                       ', id=list(method="', identifyPoints, '")', xlab, ylab, main, ')', sep = "")
      if (identifyPoints == "identify") command <- suppressMarkdown(command)
      doItAndPrint(command)
    }
    activateMenus()
    tkfocus(CommanderWindow())
  }
  groupsBox(boxPlot, initialGroup=initial.group,
            initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups")
            else paste(gettextRcmdr("Plot by:"), initial.group), window=dataTab)
  OKCancelHelp(helpSubject = "Boxplot", reset = "boxPlot", apply="boxPlot")
  tkgrid(getFrame(xBox), sticky = "nw")
  tkgrid(groupsFrame, sticky = "w")
  tkgrid(identifyFrame, stick = "w")
  tkgrid(styleFrame, stick="w")
  tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
  tkgrid(optionsFrame, sticky = "w")
  dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

DotPlot <- function () {
    defaults <- list(initial.x = NULL, initial.use.bins = 0,
                     initial.bins = gettextRcmdr ("<auto>"), initial.tab=0,
                     initial.xlab=gettextRcmdr("<auto>"),
                     initial.group = NULL)
    dialog.values <- getDialog("DotPlot", defaults)
    initializeDialog(title = gettextRcmdr("Dot Plot"), use.tabs=TRUE)
    xBox <- variableListBox(dataTab, Numeric(), title = gettextRcmdr("Variable (pick one)"),
                            initialSelection = varPosn (dialog.values$initial.x, "numeric"))
    initial.group <- dialog.values$initial.group
    .groups <- if (is.null(initial.group)) FALSE else initial.group
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        x <- getSelection(xBox)
        closeDialog()
        if (length(x) == 0) {
            errorCondition(recall = DotPlot, message = gettextRcmdr("You must select a variable"))
            return()
        }
        use.bins <- tclvalue(useBinsVariable) == "1"
        bins <- tclvalue(binsVariable)
        opts <- options(warn = -1)
        binstext <- if (bins == gettextRcmdr("<auto>"))
            "\"Sturges\""
        else as.numeric(bins)
        binstext <- if (use.bins) paste(', breaks=', binstext, sep="") else ""
        options(opts)
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if (xlab == gettextRcmdr("<auto>"))
            ""
        else paste(", xlab=\"", xlab, "\"", sep = "")
        putDialog ("DotPlot", list (initial.x = x, initial.bins = bins, initial.use.bins = if (use.bins) "1" else "0",
                                    initial.tab=tab, initial.xlab=tclvalue(xlabVar), 
                                    initial.group=if (.groups == FALSE) NULL else .groups))
        if (is.null(.groups) || .groups == FALSE) {
            command <- paste("with(", ActiveDataSet(), ", Dotplot(", x, ', bin=', use.bins,
                             binstext, xlab, "))", sep="")
        }
        else{
            command <- paste("with(", ActiveDataSet(), ", Dotplot(", x, ", by=", .groups, ', bin=',
                             use.bins, binstext, xlab, "))", sep="")
        }
        doItAndPrint(command)
        insertRmdSection(paste0(gettextRmdHeader("Dot Plot: "), x))
        activateMenus()
        tkfocus(CommanderWindow())
    }
    groupsBox(DotPlot, initialGroup=initial.group,
              initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups")
              else paste(gettextRcmdr("Plot by:"), initial.group), window=dataTab)
    OKCancelHelp(helpSubject = "Dotplot", reset = "DotPlot", apply="DotPlot", helpPackage="RcmdrMisc")
    optionsFrame <- tkframe(optionsTab)
    optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Options"),
                                                                font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    parFrame <- ttklabelframe(optionsFrame)
    xlabVar <- tclVar(dialog.values$initial.xlab)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    binsFrame <- tkframe(optFrame)
    useBinsVariable <- tclVar(dialog.values$initial.use.bins)
    useBinsCheckBox <- ttkcheckbutton(binsFrame, text = gettextRcmdr("Bin variable"),
                                      variable = useBinsVariable)
    binsVariable <- tclVar(dialog.values$initial.bins)
    binsField <- ttkentry(binsFrame, width = "8", textvariable = binsVariable)
    tkgrid(getFrame(xBox), sticky = "nw")
    tkgrid(groupsFrame, sticky = "w")
    tkgrid(useBinsCheckBox, sticky="w")
    tkgrid(labelRcmdr(binsFrame, text = gettextRcmdr("Number of bins: ")),
           binsField, sticky = "w")
    tkgrid(binsFrame, sticky = "w")
    tkgrid.configure(binsField, sticky = "e")
    tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
    tkgrid(optionsFrame, sticky = "w")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

scatterPlot <- function () {
    defaults <- list(initial.x = NULL, initial.y = NULL, initial.jitterx = 0, initial.jittery = 0,
        initial.logstringx = 0, initial.logstringy = 0, initial.box = 0,
        initial.line = 0, initial.smooth = 0, initial.spread = 0, initial.span = 50,
        initial.ellipse=0, initial.levels=".5, .9",
        initial.subset = gettextRcmdr ("<all valid cases>"), initial.ylab = gettextRcmdr ("<auto>"),
        initial.xlab = gettextRcmdr("<auto>"), initial.pch = gettextRcmdr("<auto>"),
        initial.cexValue = 1, initial.cex.axisValue = 1, initial.cex.labValue = 1, initialGroup=NULL, initial.lines.by.group=1,
        initial.identify=gettextRcmdr("not"), initial.identify.points="2", initial.tab=0,
        initial.main=gettextRcmdr("<auto>"), initial.legend.pos="above")
    dialog.values <- getDialog("scatterPlot", defaults)
    initial.group <- dialog.values$initial.group
    .linesByGroup <- if (dialog.values$initial.lines.by.group == 1) TRUE else FALSE
    .groups <- if (is.null(initial.group)) FALSE else initial.group
    initializeDialog(title = gettextRcmdr("Scatterplot"), use.tabs=TRUE)
    .numeric <- Numeric()
    xBox <- variableListBox(dataTab, .numeric, title = gettextRcmdr("x-variable (pick one)"),
        initialSelection = varPosn (dialog.values$initial.x, "numeric"))
    yBox <- variableListBox(dataTab, .numeric, title = gettextRcmdr("y-variable (pick one)"),
        initialSelection = varPosn (dialog.values$initial.y, "numeric"))
    optionsParFrame <- tkframe(optionsTab)
    parFrame <- ttklabelframe(optionsParFrame, labelwidget=tklabel(optionsParFrame, text=gettextRcmdr("Plot Labels and Points"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    checkBoxes(window = optionsParFrame, frame = "optionsFrame",
        boxes = c("jitterX", "jitterY", "logX", "logY",
            "boxplots", "lsLine", "smoothLine", "spread"), initialValues = c(
                dialog.values$initial.jitterx, dialog.values$initial.jittery,
                dialog.values$initial.logstringx, dialog.values$initial.logstringy,
                dialog.values$initial.box, dialog.values$initial.line, dialog.values$initial.smooth,
                dialog.values$initial.spread),labels = gettextRcmdr(c(
                    "Jitter x-variable", "Jitter y-variable", "Log x-axis",
                    "Log y-axis", "Marginal boxplots", "Least-squares line",
                    "Smooth line", "Show spread")), title = gettextRcmdr("Plot Options"), ttk=TRUE)
    sliderValue <- tclVar(dialog.values$initial.span)
    sliderFrame <- tkframe(optionsFrame)
    slider <- tkscale(sliderFrame, from = 5, to = 100, showvalue = TRUE,
        variable = sliderValue, resolution = 5, orient = "horizontal")
    ellipseVariable <- tclVar(dialog.values$initial.ellipse)
    ellipseFrame <- tkframe(optionsFrame)
    ellipseCheckBox <- ttkcheckbutton(ellipseFrame, variable=ellipseVariable)
    levelsVar <- tclVar(dialog.values$initial.levels)
    levelsFrame <- tkframe(optionsFrame)
    levelsEntry <- ttkentry(levelsFrame, width = "10", textvariable = levelsVar)
    radioButtons(window=optionsFrame, name = "identify", buttons = c("auto", "mouse",
        "not"), labels = gettextRcmdr(c("Automatically",
            "Interactively with mouse", "Do not identify")), title = gettextRcmdr("Identify Points"),
        initialValue = dialog.values$initial.identify)
    id.n.Var <- tclVar(dialog.values$initial.identify.points)
    npointsFrame <- tkframe(optionsFrame)
    npointsSpinner <- tkspinbox(npointsFrame, from=1, to=10, width=2, textvariable=id.n.Var)
    subsetBox(dataTab, subset.expression = dialog.values$initial.subset)
    tkbind(subsetEntry, "<FocusIn>", function() tkselection.clear(subsetEntry))
    xlabVar <- tclVar(dialog.values$initial.xlab)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
        ...))
    tkbind(xlabEntry, "<FocusIn>", function() tkselection.clear(xlabEntry))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    pchVar <- tclVar(dialog.values$initial.pch)
    pchEntry <- ttkentry(parFrame, width = 25, textvariable = pchVar)
    cexValue <- tclVar(dialog.values$initial.cexValue)
    cex.axisValue <- tclVar(dialog.values$initial.cex.axisValue)
    cex.labValue <- tclVar(dialog.values$initial.cex.labValue)
    cexSlider <- tkscale(parFrame, from = 0.5, to = 2.5, showvalue = TRUE,
        variable = cexValue, resolution = 0.1, orient = "horizontal")
    cex.axisSlider <- tkscale(parFrame, from = 0.5, to = 2.5,
        showvalue = TRUE, variable = cex.axisValue, resolution = 0.1,
        orient = "horizontal")
    cex.labSlider <- tkscale(parFrame, from = 0.5, to = 2.5,
        showvalue = TRUE, variable = cex.labValue, resolution = 0.1,
        orient = "horizontal")
    radioButtons(window=parFrame, name="legendPosition", buttons=c("above", "topleft", "topright",
        "bottomleft", "bottomright"), labels=gettextRcmdr(c("Above plot", "Top left", "Top right", "Bottom left",
            "Bottom right")), title=gettextRcmdr("Legend Position"),
        initialValue=dialog.values$initial.legend.pos)
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        x <- getSelection(xBox)
        y <- getSelection(yBox)
        jitter <- if ("1" == tclvalue(jitterXVariable) && "1" ==
                tclvalue(jitterYVariable))
            ", jitter=list(x=1, y=1)"
        else if ("1" == tclvalue(jitterXVariable))
            ", jitter=list(x=1)"
        else if ("1" == tclvalue(jitterYVariable))
            ", jitter=list(y=1)"
        else ""
        logstring <- ""
        if ("1" == tclvalue(logXVariable))
            logstring <- paste(logstring, "x", sep = "")
        if ("1" == tclvalue(logYVariable))
            logstring <- paste(logstring, "y", sep = "")
        identify <- tclvalue(identifyVariable)
        id.n <- tclvalue(id.n.Var)
        identify.text <- switch(identify,
            auto = paste0(", id=list(method='mahal', n=", id.n, ")"),
            mouse = ", id=list(method='identify')",
            not = "")
        box <- tclvalue(boxplotsVariable)
        line <- tclvalue(lsLineVariable)
        smooth <-  tclvalue(smoothLineVariable)
        spread <- tclvalue(spreadVariable)
        span <- as.numeric(tclvalue(sliderValue))
        initial.ellipse <- tclvalue(ellipseVariable)
        ellipse <- as.character(initial.ellipse == "1")
        save.levels <- levels <- tclvalue(levelsVar)
        levels <- gsub(",", " ", levels)
        levels <- paste("c(", gsub('[ ]+', ", ", levels), ")", sep="")
        res <- try(is.numeric(eval(parse(text=levels))), silent=TRUE)
        if (inherits(res, "try-error") || !res){
            errorCondition(recall = scatterPlot, message = 
                    gettextRcmdr("Levels for ellipses must be numeric values\n  separated by spaces or commas."))
            return()
        }
        initial.subset <- subset <- tclvalue(subsetVariable)
        subset <- if (trim.blanks(subset) == gettextRcmdr("<all valid cases>"))
            ""
        else paste(", subset=", subset, sep = "")
        cex.axis <- as.numeric(tclvalue(cex.axisValue))
        cex <- as.numeric(tclvalue(cexValue))
        cex.lab <- as.numeric(tclvalue(cex.labValue))
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if (xlab == gettextRcmdr("<auto>"))
            ""
        else paste(", xlab=\"", xlab, "\"", sep = "")
        ylab <- trim.blanks(tclvalue(ylabVar))
        ylab <- if (ylab == gettextRcmdr("<auto>"))
            ""
        else paste(", ylab=\"", ylab, "\"", sep = "")
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            ""
        else paste(", main=\"", main, "\"", sep = "")
        pchVal <- gsub(" ", ",", tclvalue(pchVar))
        legend.pos <- tclvalue(legendPositionVariable)
        closeDialog()
        if ("" == pchVal) {
            errorCondition(recall = scatterPlot, message = gettextRcmdr("No plotting characters."))
            return()
        }
        pch <- if (trim.blanks(pchVal) == gettextRcmdr("<auto>"))
            ""
        else paste(", pch=c(", pchVal, ")", sep = "")
        if (length(x) == 0 || length(y) == 0) {
            errorCondition(recall = scatterPlot, message = gettextRcmdr("You must select two variables"))
            return()
        }
        if (x == y) {
            errorCondition(recall = scatterPlot, message = gettextRcmdr("x and y variables must be different"))
            return()
        }
        if (is.na(suppressWarnings(as.numeric(id.n))) || round(as.numeric(id.n)) != as.numeric(id.n)){
            errorCondition(recall = scatterPlot, message = gettextRcmdr("number of points to identify must be an integer"))
            return()
        }
        putDialog ("scatterPlot", list (initial.x = x, initial.y = y, initial.jitterx = tclvalue(jitterXVariable),
            initial.jittery = tclvalue(jitterYVariable), initial.logstringx = tclvalue(logXVariable),
            initial.logstringy = tclvalue(logYVariable),  initial.box = box,
            initial.line = line, initial.smooth = smooth, initial.spread = spread,
            initial.span = span, initial.ellipse = initial.ellipse, initial.levels = save.levels,
            initial.subset = initial.subset, initial.xlab = tclvalue(xlabVar),
            initial.ylab = tclvalue(ylabVar), initial.cexValue = tclvalue(cexValue),
            initial.cex.axisValue = tclvalue(cex.axisValue), initial.cex.labValue = tclvalue(cex.labValue),
            initial.pch = pchVal, initial.group=if (.groups == FALSE) NULL else .groups,
            initial.lines.by.group=if (.linesByGroup) 1 else 0, initial.identify=identify, initial.identify.points=id.n,
            initial.tab=tab, initial.main=tclvalue(mainVar), initial.legend.pos=legend.pos)
        )
        .activeDataSet <- ActiveDataSet()
        log <- if (logstring != "")
            paste(", log=\"", logstring, "\"", sep = "")
        else ""
        if (identify == "mouse") {
            RcmdrTkmessageBox(title = gettextRcmdr("Identify Points"), message = paste(gettextRcmdr("Use left mouse button to identify points,\n"),
                gettextRcmdr(if (MacOSXP())
                    "esc key to exit."
                    else "right button to exit."), sep = ""), icon = "info",
                type = "ok")
        }
        box <- if ("1" == tclvalue(boxplotsVariable))
            "'xy'"
        else "FALSE"
        line <- if ("1" == tclvalue(lsLineVariable)) "TRUE" else "FALSE"
        smooth <- as.character("1" == tclvalue(smoothLineVariable))
        spread <- as.character("1" == tclvalue(spreadVariable))
        cex <- if (cex == 1)
            ""
        else paste(", cex=", cex, sep = "")
        cex.axis <- if (cex.axis == 1)
            ""
        else paste(", cex.axis=", cex.axis, sep = "")
        cex.lab <- if (cex.lab == 1)
            ""
        else paste(", cex.lab=", cex.lab, sep = "")
        if (.groups == FALSE) {
            command <- paste("scatterplot(", y, "~", x, log,
                ", regLine=", line,
                if (smooth == "TRUE") paste0(", smooth=list(span=", span/100, ", spread=", spread, ")") else ", smooth=FALSE",
                identify.text, ", boxplots=", box,
                if (ellipse == "TRUE") paste0(", ellipse=list(levels=", levels, ')') else "",
                jitter, xlab, ylab, main, cex, cex.axis,
                cex.lab, pch, ", data=", .activeDataSet, subset,
                ")", sep = "")
            if (identify == "mouse") command <- suppressMarkdown(command)
            doItAndPrint(command)
        }
        else {
            command <- paste("scatterplot(", y, "~", x, " | ",
                .groups, log, 
                ", regLine=", line,
                if (smooth == "TRUE") paste0(", smooth=list(span=", span/100, ", spread=", spread, ")") else ", smooth=FALSE",
                identify.text, ", boxplots=", box,
                if (ellipse == "TRUE") paste0(", ellipse=list(levels=", levels, ')') else "",
                jitter, xlab, ylab, main, cex,
                cex.axis, cex.lab, pch, ", by.groups=", .linesByGroup,
                if (legend.pos != "above") paste0(', legend=list(coords="', legend.pos, '")'),
                ", data=", .activeDataSet, subset, ")", sep = "")
            if (identify == "mouse") command <- suppressMarkdown(command)
            doItAndPrint(command)
        }
        activateMenus()
        tkfocus(CommanderWindow())
    }
    groupsBox(scatterPlot, plotLinesByGroup = TRUE, initialGroup=initial.group, initialLinesByGroup=dialog.values$initial.lines.by.group,
        initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups") else paste(gettextRcmdr("Plot by:"), initial.group), window=dataTab)
    OKCancelHelp(helpSubject = "scatterplot", reset = "scatterPlot", apply="scatterPlot")
    tkgrid(getFrame(xBox), getFrame(yBox), sticky = "nw", padx=6, pady=c(6, 0))
    tkgrid(labelRcmdr(sliderFrame, text = gettextRcmdr("Span for smooth")),
        slider, sticky = "swe", padx=6, pady=6)
    tkgrid(sliderFrame, sticky="w")
    tkgrid(ellipseCheckBox, labelRcmdr(ellipseFrame, text=gettextRcmdr("Plot concentration ellipse(s)")), sticky="w")
    tkgrid(ellipseFrame, sticky="w", pady=6)
    tkgrid(labelRcmdr(levelsFrame, text=gettextRcmdr("Concentration levels: ")), levelsEntry, sticky="w")
    tkgrid(levelsFrame, sticky="w")
    tkgrid(identifyFrame, sticky="w", pady=6)
    tkgrid(labelRcmdr(npointsFrame, text=gettextRcmdr("Number of points to identify  ")), npointsSpinner, sticky="w")
    tkgrid(npointsFrame, sticky="w")
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Plotting characters")),
        pchEntry, stick = "we", padx=6, pady=6)
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Point size")),
        cexSlider, sticky = "we", padx=6, pady=6)
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Axis text size")),
        cex.axisSlider, sticky = "we", padx=6, pady=6)
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Axis-labels text size")),
        cex.labSlider, sticky = "we", padx=6, pady=6)
    tkgrid(legendPositionFrame, stick="w", pady=6)
    tkgrid(optionsFrame, parFrame, sticky = "nswe", padx=6, pady=6)
    tkgrid(optionsParFrame, sticky = "we")
    tkgrid(ttklabel(dataTab, text=""))
    tkgrid(groupsFrame, sticky = "we", padx=6)
    tkgrid(ttklabel(dataTab, text=""))
    tkgrid(subsetFrame, sticky = "we", padx=6, pady=c(0, 6))
    tkgrid(labelRcmdr(top, text = " "), padx=6)
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

scatterPlotMatrix <- function () {
  defaults <- list(initial.variables = NULL, initial.line = 0, initial.smooth = 0, initial.spread = 0,
                   initial.span = 50, initial.ellipse=0, initial.levels=".5, .9",
                   initial.diag = "density", initial.subset = gettextRcmdr ("<all valid cases>"),
                   initialGroup=NULL, initial.lines.by.group=1, initial.id.n="0", initial.tab=0,
                   initial.main=gettextRcmdr("<auto>"))
  dialog.values <- getDialog("scatterPlotMatrix", defaults)
  initial.group <- dialog.values$initial.group
  .linesByGroup <- if (dialog.values$initial.lines.by.group == 1) TRUE else FALSE
  .groups <- if (is.null(initial.group)) FALSE else initial.group
  initializeDialog(title = gettextRcmdr("Scatterplot Matrix"), use.tabs=TRUE)
  variablesBox <- variableListBox(dataTab, Numeric(), title = gettextRcmdr("Select variables (three or more)"),
                                  selectmode = "multiple", initialSelection = varPosn (dialog.values$initial.variables, "numeric"))
  optionsFrame <- tkframe(optionsTab)
  optFrame <- tkframe(optionsFrame) #ttklabelframe(optionsFrame, text = gettextRcmdr("Options"))
  parFrame <- tkframe(optionsFrame) #ttklabelframe(optionsFrame, text = gettextRcmdr("Plotting Parameters"))
  checkBoxes(window = optFrame, frame = "otherFrame", boxes = c("lsLine", "smoothLine", "spread"),
             initialValues = c(dialog.values$initial.line, dialog.values$initial.smooth,
                               dialog.values$initial.spread), labels = gettextRcmdr(c("Least-squares lines",
                                                                                      "Smooth lines", "Show spread")),
             title=gettextRcmdr("Other Options"))
  identifyFrame <- tkframe(optFrame)
  id.n.Var <- tclVar(dialog.values$initial.id.n)
  npointsSpinner <- tkspinbox(identifyFrame, from=0, to=10, width=2, textvariable=id.n.Var)
  sliderValue <- tclVar(dialog.values$initial.span)
  sliderFrame <- tkframe(optFrame)
  slider <- tkscale(sliderFrame, from = 5, to = 100, showvalue = TRUE,
                    variable = sliderValue, resolution = 5, orient = "horizontal")
  ellipseVariable <- tclVar(dialog.values$initial.ellipse)
  ellipseFrame <- tkframe(optionsFrame)
  ellipseCheckBox <- ttkcheckbutton(ellipseFrame, variable=ellipseVariable)
  levelsVar <- tclVar(dialog.values$initial.levels)
  levelsFrame <- tkframe(optionsFrame)
  levelsEntry <- ttkentry(levelsFrame, width = "10", textvariable = levelsVar)
  radioButtons(window = optFrame, name = "diagonal", buttons = c("density", "histogram",
                                                                 "boxplot", "oned", "qqplot", "none"), labels = gettextRcmdr(c("Density plots",
                                                                                                                               "Histograms", "Boxplots", "One-dimensional scatterplots",
                                                                                                                               "Normal QQ plots", "Nothing (empty)")), title = gettextRcmdr("On Diagonal"),
               initialValue = dialog.values$initial.diag)
  subsetBox(dataTab, subset.expression = dialog.values$initial.subset)
  onOK <- function() {
    tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
    variables <- getSelection(variablesBox)
    closeDialog()
    if (length(variables) < 3) {
      errorCondition(recall = scatterPlotMatrix, message = gettextRcmdr("Fewer than 3 variable selected."))
      return()
    }
    line <- if ("1" == tclvalue(lsLineVariable)) "TRUE" else "FALSE"
    smooth <- as.character("1" == tclvalue(smoothLineVariable))
    spread <- as.character("1" == tclvalue(spreadVariable))
    id.n <- tclvalue(id.n.Var)
    identify.text <- if (id.n != "0") paste0(', id=list(method="mahal", n=', id.n, ")") else ""
    if (is.na(suppressWarnings(as.numeric(id.n))) || round(as.numeric(id.n)) != as.numeric(id.n)){
      errorCondition(recall = scatterPlotMatrix,
                     message = gettextRcmdr("number of points to identify must be an integer"))
      return()
    }
    span <- as.numeric(tclvalue(sliderValue))
    initial.ellipse <- tclvalue(ellipseVariable)
    ellipse <- as.character(initial.ellipse == "1")
    save.levels <- levels <- tclvalue(levelsVar)
    levels <- gsub(",", " ", levels)
    levels <- paste("c(", gsub('[ ]+', ", ", levels), ")", sep="")
    res <- try(is.numeric(eval(parse(text=levels))), silent=TRUE)
    if (inherits(res, "try-error") || !res){
      errorCondition(recall = scatterPlotMatrix, message = 
                       gettextRcmdr("Levels for ellipses must be numeric values\n  separated by spaces or commas."))
      return()
    }
    diag <- as.character(tclvalue(diagonalVariable))
    initial.subset <- subset <- tclvalue(subsetVariable)
    subset <- if (trim.blanks(subset) == gettextRcmdr("<all valid cases>")) ""
    else paste(", subset=", subset, sep="")
    main <- trim.blanks(tclvalue(mainVar))
    main <- if (main == gettextRcmdr("<auto>"))
      ""
    else paste(", main=\"", main, "\"", sep = "")
    putDialog("scatterPlotMatrix", list(initial.variables = variables, initial.line = tclvalue (lsLineVariable),
                                        initial.smooth = tclvalue(smoothLineVariable),initial.spread = tclvalue (spreadVariable),
                                        initial.span = span, initial.ellipse = initial.ellipse, initial.levels = save.levels,
                                        initial.diag = diag, initial.subset = initial.subset,
                                        initial.group=if (.groups == FALSE) NULL else .groups,
                                        initial.lines.by.group=if (.linesByGroup) 1 else 0,
                                        initial.id.n=id.n,
                                        initial.tab=tab, initial.main=tclvalue(mainVar)))
    .activeDataSet <- ActiveDataSet()
    if (.groups == FALSE) {
      command <- paste("scatterplotMatrix(~", paste(variables, collapse = "+"), ", regLine=", line,
                       if (smooth == "TRUE") paste0(", smooth=list(span=", span/100, ", spread=", spread, ")") else ", smooth=FALSE",
                       if (ellipse == "TRUE") paste0(", ellipse=list(levels=", levels, ')') else "",
                       identify.text,
                       ", diagonal=", paste0('list(method="', diag, '")'),
                       ", data=", .activeDataSet,
                       subset, main, ")", sep = "")
      logger(command)
      justDoIt(command)
    }
    else {
      command <- paste("scatterplotMatrix(~", paste(variables,
                                                    collapse = "+"), " | ", .groups, ", 
                       regLine=", line,
                       if (smooth == "TRUE") paste0(", smooth=list(span=", span/100, ", spread=", spread, ")") else ", smooth=FALSE",
                       if (ellipse == "TRUE") paste0(", ellipse=list(levels=", levels, ')') else "",
                       identify.text,
                       ", diagonal=", paste0('list(method="', diag, '")'),                       
                       ", by.groups=", .linesByGroup, ", data=", .activeDataSet, subset, main,
                       ")", sep = "")
      logger(command)
      justDoIt(command)
    }
    activateMenus()
    tkfocus(CommanderWindow())
  }
  groupsBox(scatterPlotMatrix, plotLinesByGroup = TRUE, initialGroup=initial.group, initialLinesByGroup=dialog.values$initial.lines.by.group,
            initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups") else paste(gettextRcmdr("Plot by:"), initial.group),
            window=dataTab)
  OKCancelHelp(helpSubject = "scatterplotMatrix", reset = "scatterPlotMatrix", apply = "scatterPlotMatrix")
  tkgrid(getFrame(variablesBox), sticky = "nw")
  tkgrid(diagonalFrame, sticky = "w")
  tkgrid(otherFrame, sticky = "w")
  tkgrid(labelRcmdr(sliderFrame, text = gettextRcmdr("Span for smooth")),
         slider, sticky = "w")
  tkgrid(sliderFrame, sticky="w")
  mainVar <- tclVar(dialog.values$initial.main)
  mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
  mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                             command = function(...) tkxview(mainEntry, ...))
  tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
                                                              ...))
  tkgrid(labelRcmdr(identifyFrame,
                    text = gettextRcmdr("Number of points to identify  \nin each panel and group ")),
         npointsSpinner, sticky="nw")
  tkgrid(identifyFrame, sticky="w", columnspan=2, pady=6)
  tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
  tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
  tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
  tkgrid(ellipseCheckBox, labelRcmdr(ellipseFrame, text=gettextRcmdr("Plot concentration ellipse(s)")), sticky="w")
  tkgrid(ellipseFrame, sticky="w", padx=6)
  tkgrid(labelRcmdr(levelsFrame, text=gettextRcmdr("Concentration levels: ")), levelsEntry, sticky="w")
  tkgrid(levelsFrame, sticky="w", padx=6, pady=6)
  tkgrid(optionsFrame, sticky = "w")
  tkgrid(groupsFrame, sticky = "w")
  tkgrid(subsetFrame, sticky = "w")
  dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

barGraph <- function () {
    defaults <- list (initial.variable = NULL, initial.xlab=gettextRcmdr("<auto>"),
                      initial.ylab=gettextRcmdr("<auto>"), initial.main=gettextRcmdr("<auto>"),
                      initial.group=NULL, initial.style="divided", initial.legend="above",
                      initial.scale="frequency", initial.colors="default", initial.conditional="conditional",
                      initial.showcounts=1, initial.tab=0)
    dialog.values <- getDialog ("barGraph", defaults)
    initializeDialog(title = gettextRcmdr("Bar Graph"), use.tabs=TRUE)
    optionsFrame <- tkframe(optionsTab)
    optionsFrame2 <- tkframe(optionsTab)
    variablesFrame <- tkframe(dataTab)
    variableBox <- variableListBox(variablesFrame, Factors(), title = gettextRcmdr("Variable (pick one)"),
                                   initialSelection = varPosn (dialog.values$initial.variable, "factor"))
    parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
                                                                font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    xlabVar <- tclVar(dialog.values$initial.xlab)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    showcountsVar <- tclVar(dialog.values$initial.showcounts)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
                                                                ...))
    showcountsFrame <- tkframe(parFrame)
    showcountsCheckBox <- ttkcheckbutton(showcountsFrame, variable = showcountsVar)
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    tkgrid(showcountsCheckBox, labelRcmdr(showcountsFrame, text=gettextRcmdr("Show counts or percentages in bars")), 
           sticky="w", padx=1)
    tkgrid(showcountsFrame, sticky="w", columnspan=2)
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        variable <- getSelection(variableBox)
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if (xlab == gettextRcmdr("<auto>"))
            paste(", xlab=\"", variable, "\"", sep = "")
        else paste(", xlab=\"", xlab, "\"", sep = "")
        ylab <- trim.blanks(tclvalue(ylabVar))
        scale <- tclvalue(scaleVariable)
        ylab <- if (ylab == gettextRcmdr("<auto>")){
            if (scale == "frequency")
                paste(", ylab=\"Frequency\"", sep = "")
            else paste(", ylab=\"Percent\"", sep = "")
        }
        else paste(", ylab=\"", ylab, "\"", sep = "")
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            ""
        else paste(", main=\"", main, "\"", sep = "")
        style <- tclvalue(styleVariable)
        conditional <- tclvalue(conditionalVariable)
        colors <- tclvalue(colorsVariable)
        legend <- tclvalue(legendVariable)
        showcounts <- tclvalue(showcountsVar)
        putDialog ("barGraph", list(initial.variable = variable, initial.xlab=tclvalue(xlabVar),
                                    initial.ylab=tclvalue(ylabVar), initial.main=tclvalue(mainVar), 
                                    initial.group=if (.groups == FALSE) NULL else .groups,
                                    initial.scale=scale, initial.style=style, 
                                    initial.conditional=conditional, initial.colors=colors,
                                    initial.legend=legend, initial.showcounts=showcounts, initial.tab=tab))
        closeDialog()
        if (length(variable) == 0) {
            errorCondition(recall = barGraph, message = gettextRcmdr("You must select a variable"))
            return()
        }
        scale <- if (scale == "frequency") "" else ', scale="percent"'
        showCounts <- if (showcounts == "1") ", label.bars=TRUE" else ", label.bars=FALSE"
        command <- if (.groups == FALSE){
            col <- if (colors == "default") "" else ", col=palette()[2]"
            paste("with(", ActiveDataSet(), ", Barplot(", 
                  variable, xlab, ylab, main, col, scale, showCounts, "))",
                  sep = "")
        }
        else {
            if (.groups == variable) {
                errorCondition(recall=barGraph, message=gettextRcmdr("plotting and grouping variables must be different"))
                return()
            }
            nlevels <- length(levels(eval(parse(text=paste0(ActiveDataSet(), "$", .groups)), envir=.GlobalEnv)))
            col <- if (colors == "default") "" else paste0(', col=palette()[2:', nlevels + 1,  ']')
            conditional <- if (conditional=="conditional") "" else ', conditional=FALSE'
            paste("with(", ActiveDataSet(), ", Barplot(", 
                   variable, ", by=", .groups, ', style="', style, 
                   '", legend.pos="', legend, '"',
                   xlab, ylab, main, col, scale, conditional, showCounts, "))",
                   sep = "")
        }
        doItAndPrint(command)
        insertRmdSection(paste0(gettextRmdHeader("Bar Plot: "), variable))
        activateMenus()
        tkfocus(CommanderWindow())
    }
    initial.group <- dialog.values$initial.group
    groupsBox(barGraph, initialGroup=initial.group, 
              initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups") 
              else paste(gettextRcmdr("Plot by:"), initial.group), window=variablesFrame)
    radioButtons(optionsFrame2, name = "scale", buttons = c("frequency", "percent"), 
                 labels = gettextRcmdr(c("Frequency counts", "Percentages")), 
                 title = gettextRcmdr("Axis Scaling"),
                 initialValue = dialog.values$initial.scale)
    radioButtons(optionsFrame2, name = "style", buttons = c("divided", "parallel"), 
                 labels = gettextRcmdr(c("Divided (stacked)", "Side-by-side (parallel)")), 
                 title = gettextRcmdr("Style of Group Bars"),
                 initialValue = dialog.values$initial.style)
    radioButtons(optionsFrame2, name = "conditional", buttons = c("conditional", "total"), 
                 labels = gettextRcmdr(c("Conditional", "Total")), 
                 title = gettextRcmdr("Percentages for Group Bars"),
                 initialValue = dialog.values$initial.conditional)
    radioButtons(optionsFrame2, name = "colors", buttons = c("default", "palette"), 
                 labels = gettextRcmdr(c("Default", "From color palette")), 
                 title = gettextRcmdr("Color Selection"),
                 initialValue = dialog.values$initial.colors)
    radioButtons(optionsFrame2, name = "legend", 
                 buttons = c("above", "topright", "top", "topleft"), 
                 labels = gettextRcmdr(c("Above plot", "Right", "Center", "Left")), 
                 title = gettextRcmdr("Position of Legend"),
                 initialValue = dialog.values$initial.legend)
    OKCancelHelp(helpSubject = "Barplot", reset = "barGraph", apply = "barGraph")
    tkgrid(getFrame(variableBox), sticky="w")
    tkgrid(tklabel(variablesFrame, text=""))
    tkgrid(groupsFrame, sticky="w")
    tkgrid(scaleFrame, sticky="w")
    tkgrid(colorsFrame, sticky="w")
    tkgrid(styleFrame, sticky="w")
    tkgrid(conditionalFrame, sticky="w")
    tkgrid(legendFrame, sticky="w")
    tkgrid(variablesFrame, sticky="w")
    tkgrid(parFrame, sticky = "nw")
    tkgrid(optionsFrame2, optionsFrame, sticky = "nw")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

pieChart <- function () {
    Library("colorspace")
    defaults <- list (initial.variable = NULL, initial.xlab=gettextRcmdr("<auto>"),
        initial.ylab=gettextRcmdr("<auto>"), initial.main=gettextRcmdr("<auto>"), 
        initial.colors="default", initial.scale="percent")
    dialog.values <- getDialog ("pieChart", defaults)
    initializeDialog(title = gettextRcmdr("Pie Chart"))
    optionsFrame <- tkframe(top)
    leftOptionsFrame <- tkframe(optionsFrame)
    variableBox <- variableListBox(leftOptionsFrame, Factors(), title = gettextRcmdr("Variable (pick one)"),
        initialSelection = varPosn (dialog.values$initial.variable, "factor"))
    radioButtons(leftOptionsFrame, name = "colors", buttons = c("default", "palette"), 
                 labels = gettextRcmdr(c("Default", "From color palette")), 
                 title = gettextRcmdr("Color Selection"),
                 initialValue = dialog.values$initial.colors)
    radioButtons(leftOptionsFrame, name = "scale", buttons = c("percent", "frequency", "none"), 
                 labels = gettextRcmdr(c("Percentages", "Frequency counts", "Neither")), 
                 title = gettextRcmdr("Include in Segment Labels"),
                 initialValue = dialog.values$initial.scale)
    parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    xlabVar <- tclVar(dialog.values$initial.xlab)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    onOK <- function() {
        variable <- getSelection(variableBox)
        colors <- tclvalue(colorsVariable)
        scale <- tclvalue(scaleVariable)
        scale <- paste0(', scale="', scale, '"')
        nlevels <- length(levels(eval(parse(text=paste0(ActiveDataSet(), "$", variable)), envir=.GlobalEnv)))
        col <- if (colors == "default") paste0(', col=rainbow_hcl(', nlevels,  ')')
            else paste0(', col=palette()[2:', nlevels + 1,  ']')
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if (xlab == gettextRcmdr("<auto>"))
            paste(", xlab=\"\"", sep = "")
        else paste(", xlab=\"", xlab, "\"", sep = "")
        ylab <- trim.blanks(tclvalue(ylabVar))
        ylab <- if (ylab == gettextRcmdr("<auto>"))
            paste(", ylab=\"\"", sep = "")
        else paste(", ylab=\"", ylab, "\"", sep = "")
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            paste(", main=\"", variable, "\"", sep = "")
        else paste(", main=\"", main, "\"", sep = "")
        putDialog ("pieChart", list (initial.variable = variable, 
            initial.colors=colors, initial.xlab=tclvalue(xlabVar),
            initial.ylab=tclvalue(ylabVar), initial.main=tclvalue(mainVar),
            initial.scale=tclvalue(scaleVariable)))
        closeDialog()
        if (length(variable) == 0) {
            errorCondition(recall = pieChart, message = gettextRcmdr("You must select a variable"))
            return()
        }
        .activeDataSet <- ActiveDataSet()
        command <- paste("with(", .activeDataSet, ", piechart(", 
            variable, xlab, ylab, main, col, scale,
            "))", sep = "")
        logger(command)
        justDoIt(command)
        insertRmdSection(paste0(gettextRmdHeader("Pie Chart: "), variable))
        activateMenus()
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject = "pie", reset = "pieChart", apply = "pieChart")
    tkgrid(getFrame(variableBox), sticky="w")
    tkgrid(colorsFrame, sticky="w")
    tkgrid(scaleFrame, sticky="w")
    tkgrid(leftOptionsFrame, parFrame, sticky = "nw")
    tkgrid(optionsFrame, sticky = "w")
    dialogSuffix(grid.buttons=TRUE)
}

linePlot <- function () {
    defaults <- list(initial.x = NULL, initial.y = NULL) 
    dialog.values <- getDialog("linePlot", defaults)
    initializeDialog(title = gettextRcmdr("Line Plot"))
    variablesFrame <- tkframe(top)
    .numeric <- Numeric()
    xBox <- variableListBox(variablesFrame, .numeric, title = gettextRcmdr("x variable (pick one)"),
        initialSelection = varPosn (dialog.values$initial.x, "numeric"))
    yBox <- variableListBox(variablesFrame, .numeric, title = gettextRcmdr("y variables (pick one or more)"), 
        selectmode = "multiple", initialSelection = varPosn (dialog.values$initial.y, "numeric"))
    onOK <- function() {
        y <- getSelection(yBox)
        x <- getSelection(xBox)
        closeDialog()
        if (0 == length(x)) {
            errorCondition(recall = linePlot, message = gettextRcmdr("No x variable selected."))
            return()
        }
        if (0 == length(y)) {
            errorCondition(recall = linePlot, message = gettextRcmdr("No y variables selected."))
            return()
        }
        if (is.element(x, y)) {
            errorCondition(recall = linePlot, message = gettextRcmdr("x and y variables must be different."))
            return()
        }
        .activeDataSet <- ActiveDataSet()
        .x <- na.omit(eval(parse(text = paste(.activeDataSet, 
            "$", x, sep = "")), envir = .GlobalEnv))
        if (!identical(order(.x), seq(along.with = .x))) {
            response <- tclvalue(RcmdrTkmessageBox(message = gettextRcmdr("x-values are not in order.\nContinue?"), 
                icon = "warning", type = "okcancel", default = "cancel"))
            if (response == "cancel") {
                onCancel()
                return()
            }
        }
        putDialog ("linePlot", list(initial.x = x, initial.y = y))
        command <- paste("with(", .activeDataSet, ", lineplot(", x, ", ", paste(y, collapse=", "), "))", sep="")
        doItAndPrint(command)
        insertRmdSection(paste0(gettextRmdHeader("Line Plot: "), paste(y, collapse=", "), " by ",  x))
        activateMenus()
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject = "lineplot", reset = "linePlot", apply = "linePlot")
    tkgrid(getFrame(xBox), labelRcmdr(variablesFrame, text = "    "), 
        getFrame(yBox), sticky = "nw")
    tkgrid(variablesFrame, sticky = "nw")
    tkgrid(buttonsFrame, stick = "w")
    dialogSuffix()
}

QQPlot <- function () {
    # this function modified by Martin Maechler
    defaults <- list(initial.x = NULL, initial.dist = "norm", initial.df = "",
                     initial.chisqdf = "", initial.fdf1 = "", initial.fdf2 = "", initial.othername = "",
                     initial.otherparam = "", initial.identify = "auto", initial.id.n="2",
                     initial.tab=0, initial.xlab=gettextRcmdr("<auto>"), initial.ylab=gettextRcmdr("<auto>"),
                     initial.main=gettextRcmdr("<auto>"), initial.group = NULL)
    dialog.values <- getDialog("QQPlot", defaults)
    initial.group <- dialog.values$initial.group
    .groups <- if (is.null(initial.group)) FALSE else initial.group
    initializeDialog(title = gettextRcmdr("Quantile-Comparison (QQ) Plot"), use.tabs=TRUE)
    xBox <- variableListBox(dataTab, Numeric(), title = gettextRcmdr("Variable (pick one)"),
                            initialSelection = varPosn (dialog.values$initial.x, "numeric"))
    optionsFrame <- tkframe(optionsTab)
    optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Options"),
                                                                font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
                                                                font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    identifyPointsFrame <- tkframe(optFrame)
    radioButtons(identifyPointsFrame, name = "identify", buttons = c("auto", "mouse",
                                                                     "not"), labels = gettextRcmdr(c("Automatically",
                                                                                                     "Interactively with mouse", "Do not identify")), title = gettextRcmdr("Identify Points"),
                 initialValue = dialog.values$initial.identify)
    id.n.Var <- tclVar(dialog.values$initial.id.n)
    npointsSpinner <- tkspinbox(identifyPointsFrame, from=1, to=10, width=2, textvariable=id.n.Var)
    xlabVar <- tclVar(dialog.values$initial.xlab)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        x <- getSelection(xBox)
        initial.dist <-dist <- tclvalue(distVariable)
        tdf <- tclvalue(tDfVariable)
        chisqdf <- tclvalue(chisqDfVariable)
        fdf1 <- tclvalue(FDf1Variable)
        fdf2 <- tclvalue(FDf2Variable)
        othername <- tclvalue(otherNameVariable)
        otherparam <- tclvalue(otherParamsVariable)
        id.n <- tclvalue(id.n.Var)
        identify <- tclvalue(identifyVariable)
        method <- if (identify == "mouse") "identify" else "y"
        id.n.use <- if (identify == "not") 0 else id.n
        closeDialog()
        if (0 == length(x)) {
            errorCondition(recall = QQPlot, message = gettextRcmdr("You must select a variable."))
            return()
        }
        save <- options(warn = -1)
        on.exit(save)
        retryMe <- function(msg) {
            Message(message = msg, type = "error")
            QQPlot()
        }
        switch(dist, norm = {
            args <- "dist=\"norm\""
        }, t = {
            df <- tclvalue(tDfVariable)
            df.num <- as.numeric(df)
            if (is.na(df.num) || df.num < 1) {
                retryMe(gettextRcmdr("df for t must be a positive number."))
                return()
            }
            args <- paste("dist=\"t\", df=", df, sep = "")
        }, chisq = {
            df <- tclvalue(chisqDfVariable)
            df.num <- as.numeric(df)
            if (is.na(df.num) || df.num < 1) {
                retryMe(gettextRcmdr("df for chi-square must be a positive number."))
                return()
            }
            args <- paste("dist=\"chisq\", df=", df, sep = "")
        }, f = {
            df1 <- tclvalue(FDf1Variable)
            df2 <- tclvalue(FDf2Variable)
            df.num1 <- as.numeric(df1)
            df.num2 <- as.numeric(df2)
            if (is.na(df.num1) || df.num1 < 1 || is.na(df.num2) ||
                df.num2 < 1) {
                retryMe(gettextRcmdr("numerator and denominator \ndf for F must be positive numbers."))
                return()
            }
            args <- paste("dist=\"f\", df1=", df1, ", df2=",
                          df2, sep = "")
        }, {
            dist <- tclvalue(otherNameVariable)
            params <- tclvalue(otherParamsVariable)
            args <- paste("dist=\"", dist, "\", ", params, sep = "")
        })
        if (is.na(suppressWarnings(as.numeric(id.n))) || round(as.numeric(id.n)) != as.numeric(id.n)){
            errorCondition(recall = QQPlot, message = gettextRcmdr("number of points to identify must be an integer"))
            return()
        }
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if (xlab == gettextRcmdr("<auto>"))
            ""
        else paste(", xlab=\"", xlab, "\"", sep = "")
        ylab <- trim.blanks(tclvalue(ylabVar))
        ylab <- if (ylab == gettextRcmdr("<auto>"))
            ""
        else paste(", ylab=\"", ylab, "\"", sep = "")
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            ""
        else paste(", main=\"", main, "\"", sep = "")
        putDialog ("QQPlot", list (initial.x = x, initial.dist = initial.dist,
                                   initial.identify = identify, initial.df = tdf, initial.chisqdf = chisqdf,
                                   initial.fdf1 = fdf1, initial.fdf2 = fdf2, initial.othername = othername,
                                   initial.otherparam = otherparam, initial.identify = identify, initial.id.n=id.n,
                                   initial.tab=tab, initial.xlab=tclvalue(xlabVar),
                                   initial.ylab=tclvalue(ylabVar), initial.main=tclvalue(mainVar),
                                   initial.group=if (.groups == FALSE) NULL else .groups))
        .activeDataSet <- ActiveDataSet()
        if (identify == "mouse") {
            RcmdrTkmessageBox(title = "Identify Points", message = paste(gettextRcmdr("Use left mouse button to identify points,\n"),
                                                                         gettextRcmdr(if (MacOSXP())
                                                                             "esc key to exit."
                                                                             else "right button to exit."), sep = ""), icon = "info",
                              type = "ok")
        }
        command <- if (is.null(.groups) || .groups == FALSE) {
            paste("with(", .activeDataSet, ", qqPlot", "(", 
                  x, ", ", args, ', id=list(method="', method, '", n=', id.n.use, ", labels=rownames(", .activeDataSet, "))", xlab,
                  ylab, main, "))", sep = "")
        } else {
            paste("with(", .activeDataSet, ", qqPlot", "(", 
                  x, ", ", args, ', id=list(method="', method, '", n=', id.n.use, ", labels=rownames(", .activeDataSet, "))", xlab,
                  ylab, main, ", groups=", .groups, "))", sep = "")
        }
        if (identify == "mouse") command <- suppressMarkdown(command)
        doItAndPrint(command)
        insertRmdSection(paste0(gettextRmdHeader("Quantile-Comparison Plot: "), x))
        activateMenus()
        tkfocus(CommanderWindow())
    }
    groupsBox(QQPlot, initialGroup=initial.group,
              initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups")
              else paste(gettextRcmdr("Plot by:"), initial.group), window=dataTab)
    OKCancelHelp(helpSubject = "qqPlot", reset = "QQPlot", apply="QQPlot")
    distFrame <- tkframe(optFrame)
    distVariable <- tclVar(dialog.values$initial.dist)
    normalButton <- ttkradiobutton(distFrame, variable = distVariable,
                                   value = "norm")
    tButton <- ttkradiobutton(distFrame, variable = distVariable,
                              value = "t")
    chisqButton <- ttkradiobutton(distFrame, variable = distVariable,
                                  value = "chisq")
    FButton <- ttkradiobutton(distFrame, variable = distVariable,
                              value = "f")
    otherButton <- ttkradiobutton(distFrame, variable = distVariable,
                                  value = "other")
    tDfFrame <- tkframe(distFrame)
    tDfVariable <- tclVar(dialog.values$initial.df)
    tDfField <- ttkentry(tDfFrame, width = "6", textvariable = tDfVariable)
    chisqDfFrame <- tkframe(distFrame)
    chisqDfVariable <- tclVar(dialog.values$initial.chisqdf)
    chisqDfField <- ttkentry(chisqDfFrame, width = "6", textvariable = chisqDfVariable)
    FDfFrame <- tkframe(distFrame)
    FDf1Variable <- tclVar(dialog.values$initial.fdf1)
    FDf1Field <- ttkentry(FDfFrame, width = "6", textvariable = FDf1Variable)
    FDf2Variable <- tclVar(dialog.values$initial.fdf2)
    FDf2Field <- ttkentry(FDfFrame, width = "6", textvariable = FDf2Variable)
    otherParamsFrame <- tkframe(distFrame)
    otherParamsVariable <- tclVar(dialog.values$initial.otherparam)
    otherParamsField <- ttkentry(otherParamsFrame, width = "30",
                                 textvariable = otherParamsVariable)
    otherNameVariable <- tclVar(dialog.values$initial.othername)
    otherNameField <- ttkentry(otherParamsFrame, width = "10",
                               textvariable = otherNameVariable)
    tkgrid(getFrame(xBox), sticky = "nw")
    tkgrid(groupsFrame, sticky = "w")
    tkgrid(labelRcmdr(distFrame, text = gettextRcmdr("Distribution"),
                      fg = getRcmdr("title.color"), font="RcmdrTitleFont"), columnspan = 6, sticky = "w")
    tkgrid(normalButton, labelRcmdr(distFrame, text = gettextRcmdr("Normal")),
           sticky = "w")
    tkgrid(labelRcmdr(tDfFrame, text = gettextRcmdr("df = ")),
           tDfField, sticky = "w")
    tkgrid(tButton, labelRcmdr(distFrame, text = "t"), tDfFrame,
           sticky = "w")
    tkgrid(labelRcmdr(chisqDfFrame, text = gettextRcmdr("df = ")),
           chisqDfField, sticky = "w")
    tkgrid(chisqButton, labelRcmdr(distFrame, text = gettextRcmdr("Chi-square")),
           chisqDfFrame, sticky = "w")
    tkgrid(labelRcmdr(FDfFrame, text = gettextRcmdr("Numerator df = ")),
           FDf1Field, labelRcmdr(FDfFrame, text = gettextRcmdr("Denominator df = ")),
           FDf2Field, sticky = "w")
    tkgrid(FButton, labelRcmdr(distFrame, text = "F"), FDfFrame,
           sticky = "w")
    tkgrid(labelRcmdr(otherParamsFrame, text = gettextRcmdr("Specify: ")),
           otherNameField, labelRcmdr(otherParamsFrame, text = gettextRcmdr("Parameters: ")),
           otherParamsField, sticky = "w")
    tkgrid(otherButton, labelRcmdr(distFrame, text = gettextRcmdr("Other")),
           otherParamsFrame, sticky = "w")
    tkgrid(distFrame, sticky = "w")
    tkgrid(identifyFrame, sticky="w")
    tkgrid(labelRcmdr(identifyPointsFrame, text=gettextRcmdr("Number of points to identify  ")), npointsSpinner, sticky="w")
    tkgrid(identifyPointsFrame, sticky="w")
    tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
    tkgrid(optionsFrame, sticky = "w")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

PlotMeans <- function () {
    defaults <- list(initial.groups = NULL, initial.response = NULL, initial.error.bars = "se",
        initial.level = "0.95", initial.xlab=gettextRcmdr("<auto>"), initial.ylab=gettextRcmdr("<auto>"),
        initial.main=gettextRcmdr("<auto>"), initial.connect="1", initial.legend="farright", initial.tab=0)
    dialog.values <- getDialog("PlotMeans", defaults)
    initializeDialog(title = gettextRcmdr("Plot Means"), use.tabs=TRUE)
    groupBox <- variableListBox(dataTab, Factors(), title = gettextRcmdr("Factors (pick one or two)"),
        selectmode = "multiple", initialSelection = varPosn (dialog.values$initial.groups, "factor"))
    responseBox <- variableListBox(dataTab, Numeric(), title = gettextRcmdr("Response Variable (pick one)"),
        initialSelection = varPosn (dialog.values$initial.response, "numeric"))
    optionsFrame <- tkframe(optionsTab)
    optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Error Bars"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    xlabVar <- tclVar(dialog.values$initial.xlab)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    connectvar <- tclVar(dialog.values$initial.connect)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
        ...))
    connectFrame <- tkframe(optionsFrame)
    connectCheckBox <- ttkcheckbutton(connectFrame, variable = connectvar)
    radioButtons(connectFrame, name="legend", buttons=c("farright", "topleft", "top", "topright"),
                 initialValue=dialog.values$initial.legend,
                 labels=gettextRcmdr(c("To right of graph", "Top left", "Top center", "Top right")),
                 title=gettextRcmdr("Position of Legend"))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        groups <- getSelection(groupBox)
        response <- getSelection(responseBox)
        legend.pos <- tclvalue(legendVariable)
        closeDialog()
        if (0 == length(groups)) {
            errorCondition(recall = PlotMeans, message = gettextRcmdr("No factors selected."))
            return()
        }
        if (2 < length(groups)) {
            errorCondition(recall = PlotMeans, message = gettextRcmdr("More than two factors selected."))
            return()
        }
        if (0 == length(response)) {
            errorCondition(recall = PlotMeans, message = gettextRcmdr("No response variable selected."))
            return()
        }
        .activeDataSet <- ActiveDataSet()
        error.bars <- tclvalue(errorBarsVariable)
        level <- if (error.bars == "conf.int")
            paste(", level=", tclvalue(levelVariable), sep = "")
        else ""
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if (xlab == gettextRcmdr("<auto>"))
            ""
        else paste(", xlab=\"", xlab, "\"", sep = "")
        ylab <- trim.blanks(tclvalue(ylabVar))
        ylab <- if (ylab == gettextRcmdr("<auto>"))
            ""
        else paste(", ylab=\"", ylab, "\"", sep = "")
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            ""
        else paste(", main=\"", main, "\"", sep = "")
        connect <- tclvalue(connectvar)
        putDialog ("PlotMeans", list(initial.groups = groups, initial.response = response,
            initial.error.bars = error.bars,
            initial.level = tclvalue(levelVariable),
            initial.xlab=tclvalue(xlabVar), initial.ylab=tclvalue(ylabVar),
            initial.main=tclvalue(mainVar), initial.connect=connect,
            initial.legend=legend.pos, initial.tab=tab))
        if (length(groups) == 1)
            doItAndPrint(paste("with(", .activeDataSet, ", plotMeans(", 
                response, ", ", groups[1],
                ", error.bars=\"", error.bars, "\"", level, xlab, ylab, main, 
                ", connect=", if (connect == "1") "TRUE" else "FALSE", "))",
                sep = ""))
        else {
            if (eval(parse(text = paste("with(", .activeDataSet, ", length(levels(", 
                groups[1], ")) < length(levels(", 
                groups[2], ")))", sep = ""))))
                groups <- rev(groups)
            doItAndPrint(paste("with(", .activeDataSet, ", plotMeans(", 
                response, ", ", groups[1],
                ", ", groups[2], ", error.bars=\"",
                error.bars, "\"", level, xlab, ylab, main, 
                ", connect=", if (connect == "1") "TRUE" else "FALSE",
                ", legend.pos=\"", legend.pos, "\"))", sep = ""))
        }
        insertRmdSection(paste0(gettextRmdHeader("Plot of Means: "), response, " by ", paste(groups, collapse=", ")))
        activateMenus()
        tkfocus(CommanderWindow())
    }
    errorBarsVariable <- tclVar(dialog.values$initial.error.bars)
    seButton <- ttkradiobutton(optFrame, variable = errorBarsVariable,
        value = "se")
    sdButton <- ttkradiobutton(optFrame, variable = errorBarsVariable,
        value = "sd")
    confIntButton <- ttkradiobutton(optFrame, variable = errorBarsVariable,
        value = "conf.int")
    noneButton <- ttkradiobutton(optFrame, variable = errorBarsVariable,
        value = "none")
    levelVariable <- tclVar(dialog.values$initial.level)
    levelEntry <- ttkentry(optFrame, width = "6", textvariable = levelVariable)
    OKCancelHelp(helpSubject = "plotMeans", reset = "PlotMeans", apply = "PlotMeans")
    tkgrid(getFrame(groupBox), getFrame(responseBox), sticky = "nw")
    tkgrid(seButton, labelRcmdr(optFrame, text = gettextRcmdr("Standard errors")),
        sticky = "w")
    tkgrid(sdButton, labelRcmdr(optFrame, text = gettextRcmdr("Standard deviations")),
        sticky = "w")
    tkgrid(confIntButton, labelRcmdr(optFrame, text = gettextRcmdr("Confidence intervals")),
        labelRcmdr(optFrame, text = gettextRcmdr("   Level of confidence:")),
        levelEntry, sticky = "w")
    tkgrid(noneButton, labelRcmdr(optFrame, text = gettextRcmdr("No error bars")),
        sticky = "w")
    tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
    tkgrid(legendFrame, sticky="w")
    tkgrid(labelRcmdr(connectFrame, text=gettextRcmdr("Connect profiles of means")), connectCheckBox, sticky="w")
    tkgrid(labelRcmdr(connectFrame, text=""), sticky="w")
    tkgrid(connectFrame, sticky="w")
    tkgrid(optionsFrame, sticky = "w")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

#' @name Scatter3DDialog
#'
#' @aliases Scatter3DDialog Scatter3D
#'
#' @title Rcmdr 3D Scatterplot Dialog
#'
#' @keywords hplot
#' 
#' @author John Fox
#' 
#' @details
#'
#' Dialog for 3D Scatterplot function.
#' 
#' This dialog sets up a call to the \code{\link[car]{scatter3d}} function to draw a three-dimensional scatterplot, and optionally to \code{\link[car:scatter3d]{Identify3d}} to label points interactively with the mouse.
#'
#' The explanatory variables provide the "horizontal" and "out-of-screen" axes of the scatterplot, the response variable provides the "vertical" axis.
#'
#' Data points are represented as spheres or points, depending upon the number of observations.
#'
#' Several regression surfaces can be plotted: a linear least-squares surface; a full quadratic least-squares surface with squared and cross-product terms; a "smooth" regression surface --- either a smoothing spline, if no degrees of freedom are specified (in which case the \code{\link[mgcv]{gam}} function selects the df by generalized cross validation), or a fixed-df regression spline; an additive-regression surface (also fit by \code{gam}), with either smoothing spline or regression spline components (again selected according to the specification of degrees of freedom).
#' If only one surface is fit, then residuals are plotted as red (negative) and green (positive) lines from the surface to the points.
#'
#' You can specify a factor defining groups by pressing the \emph{Plot by groups} button.
#' A separate surface or set of surfaces is plotted for each level of the groups factor.
#' These surfaces can be constrained to be parallel.
#'
#' The completed plot can be manipulated with the mouse: Click, hold, drag the left mouse button to rotate the display; click, hold, and drag the right button (or centre button on a three-button mouse) to zoom in and out.
#'
#' If the box labelled \emph{Identify observations with mouse} is checked, you may use the mouse to identify points interactively: Press the right mouse button (or the centre button on a three-button mouse), drag a rectangle around the points to be identified, and release the button.
#' Repeat this procedure for each point or set of "nearby" points to be identified. To exit from point-identification mode, right-click (or centre-click) in an empty region of the plot.
#'
#' Points may also be identified subsequently by selecting \emph{Identify observations with mouse} from the R Commander \emph{3D graph} menu: As above, click and drag the left mouse button to rotate the display, and click and drag the right (or centre) button to identify points.
#'
#' @seealso \code{\link[car]{scatter3d}}, \code{\link[car:scatter3d]{Identify3d}}, \code{\link[rgl]{rgl-package}}, \code{\link[mgcv]{gam}}.
#' 
Scatter3D <- function () {
  use.rgl <- getOption("Rcmdr")$use.rgl
  if (is.null(use.rgl) || use.rgl) {
    Library("rgl")
    Library("mgcv")
  }
  putRcmdr("rgl.command", TRUE)
  defaults <- list (initial.x = NULL, initial.y = NULL, initial.scales = 1, initial.grid = 1, 
                    initial.resids = 0, initial.lin = 0, initial.robust=0, initial.quad = 0, initial.nonpar = 0, 
                    initial.additive = 0, initial.ellips = 0, initial.dfNonpar = gettextRcmdr("<auto>"), 
                    initial.dfAdd = gettextRcmdr("<auto>"), initial.bg = "white",
                    initialGroup=NULL, initial.lines.by.group=0, initial.identify="not", initial.id.n="2",
                    initial.rotations=0, initial.tab=0)
  dialog.values <- getDialog ("Scatter3D", defaults)
  initial.group <- dialog.values$initial.group
  .linesByGroup <- if (dialog.values$initial.lines.by.group == 1) TRUE else FALSE
  .groups <- if (is.null(initial.group)) FALSE else initial.group
  initializeDialog(title = gettextRcmdr("3D Scatterplot"), use.tabs=TRUE)
  variablesFrame <- tkframe(dataTab)
  .numeric <- Numeric()
  xBox <- variableListBox(variablesFrame, .numeric, title = gettextRcmdr("Explanatory variables (pick two)"), 
                          selectmode = "multiple", initialSelection = varPosn (dialog.values$initial.x, "numeric"))
  yBox <- variableListBox(variablesFrame, .numeric, title = gettextRcmdr("Response variable (pick one)"), 
                          initialSelection = varPosn (dialog.values$initial.y, "numeric"))
  surfacesFrame <- tkframe(optionsTab)
  axisScales <- tclVar(dialog.values$initial.scales)
  axisScalesCheckBox <- ttkcheckbutton(surfacesFrame, variable = axisScales)
  gridLines <- tclVar(dialog.values$initial.grid)
  gridLinesCheckBox <- ttkcheckbutton(surfacesFrame, variable = gridLines)
  squaredResiduals <- tclVar(dialog.values$initial.resids)
  squaredResidualsCheckBox <- ttkcheckbutton(surfacesFrame, 
                                             variable = squaredResiduals)
  linearLSSurface <- tclVar(dialog.values$initial.lin)
  linearLSCheckBox <- ttkcheckbutton(surfacesFrame, variable = linearLSSurface)
  robustSurface <- tclVar(dialog.values$initial.robust)
  robustCheckBox <- ttkcheckbutton(surfacesFrame, variable = robustSurface)
  quadLSSurface <- tclVar(dialog.values$initial.quad)
  quadLSCheckBox <- ttkcheckbutton(surfacesFrame, variable = quadLSSurface)
  nonparSurface <- tclVar(dialog.values$initial.nonpar)
  nonparCheckBox <- ttkcheckbutton(surfacesFrame, variable = nonparSurface)
  dfNonparVariable <- tclVar(dialog.values$initial.dfNonpar)
  dfNonparField <- ttkentry(surfacesFrame, width = "6", textvariable = dfNonparVariable)
  additiveSurface <- tclVar(dialog.values$initial.additive)
  additiveCheckBox <- ttkcheckbutton(surfacesFrame, variable = additiveSurface)
  dfAddVariable <- tclVar(dialog.values$initial.dfAdd)
  dfAddField <- ttkentry(surfacesFrame, width = "6", textvariable = dfAddVariable)
  ellipsoid <- tclVar(dialog.values$initial.ellips)
  ellipsoidCheckBox <- ttkcheckbutton(surfacesFrame, variable = ellipsoid)
  bgFrame <- tkframe(optionsTab)
  bgVariable <- tclVar(dialog.values$initial.bg)
  whiteButton <- ttkradiobutton(bgFrame, variable = bgVariable, 
                                value = "white")
  blackButton <- ttkradiobutton(bgFrame, variable = bgVariable, 
                                value = "black")
  idFrame <- tkframe(optionsTab)
  radioButtons(window=idFrame, name = "identify", buttons = c("auto", "mouse", 
                                                              "not"), labels = gettextRcmdr(c("Automatically", 
                                                                                              "Interactively with mouse", "Do not identify")), title = gettextRcmdr("Identify Points"), 
               initialValue = dialog.values$initial.identify)
  id.n.Var <- tclVar(dialog.values$initial.id.n) 
  npointsSpinner <- tkspinbox(idFrame, from=1, to=10, width=2, textvariable=id.n.Var) 
  rotationsVar <- tclVar(dialog.values$initial.rotations)
  rotationsSpinner <- tkspinbox(surfacesFrame, from=0, to=10, width=2, textvariable=rotationsVar) 
  onOK <- function() {
    tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
    x <- getSelection(xBox)
    y <- getSelection(yBox)
    scales <- tclvalue(axisScales)
    grid <- tclvalue(gridLines)
    resids <- tclvalue(squaredResiduals)
    lin <- tclvalue(linearLSSurface)
    robust <- tclvalue(robustSurface)
    quad <- tclvalue(quadLSSurface)
    nonpar <- tclvalue(nonparSurface)
    additive <- tclvalue(additiveSurface)
    ellips <- tclvalue(ellipsoid) 
    dfNonpar <- tclvalue(dfNonparVariable)
    dfAdd <- tclvalue(dfAddVariable)
    bg <- tclvalue(bgVariable)
    identify <- tclvalue(identifyVariable)
    id.n <- tclvalue(id.n.Var)
    identify.text <- switch(identify,
                            auto = paste0(", id=list(method='mahal', n =", id.n, ")"),
                            mouse = ", id=list(method='identify')",
                            not = "")
    rotations <- tclvalue(rotationsVar)
    closeDialog()
    if (is.na(suppressWarnings(as.numeric(id.n))) || round(as.numeric(id.n)) != as.numeric(id.n)){
      errorCondition(recall = scatterPlot, message = gettextRcmdr("number of points to identify must be an integer"))
      return()
    }
    if (length(y) == 0) {
      errorCondition(recall = Scatter3D, message = gettextRcmdr("You must select a response variable."))
      return()
    }
    if (2 != length(x)) {
      errorCondition(recall = Scatter3D, message = gettextRcmdr("You must select 2 explanatory variables."))
      return()
    }
    if (is.element(y, x)) {
      errorCondition(recall = Scatter3D, message = gettextRcmdr("Response and explanatory variables must be different."))
      return()
    }
    putDialog ("Scatter3D", list(initial.x = x, initial.y = y, initial.scales = scales, initial.grid = grid, 
                                 initial.resids = resids, initial.lin = lin, initial.robust=robust,
                                 initial.quad = quad, initial.nonpar = nonpar, 
                                 initial.additive = additive, initial.ellips = ellips, initial.dfNonpar = dfNonpar, 
                                 initial.dfAdd = dfAdd, initial.bg = bg, 
                                 initial.group=if (.groups == FALSE) NULL else .groups,
                                 initial.lines.by.group=if (.linesByGroup) 1 else 0,
                                 initial.identify=identify, initial.id.n=id.n,
                                 initial.rotations=rotations, initial.tab=tab))
    scales <- if (tclvalue(axisScales) == 1) 
      "TRUE"
    else "FALSE"
    grid <- if (tclvalue(gridLines) == 1) 
      "TRUE"
    else "FALSE"
    resids <- if (tclvalue(squaredResiduals) == 1) 
      ", residuals=\"squares\""
    else ", residuals=TRUE"
    lin <- if (tclvalue(linearLSSurface) == 1) 
      "\"linear\""
    robust <- if (tclvalue(robustSurface) == 1) 
      "\"robust\""
    quad <- if (tclvalue(quadLSSurface) == 1) 
      "\"quadratic\""
    nonpar <- if (tclvalue(nonparSurface) == 1) 
      "\"smooth\""
    additive <- if (tclvalue(additiveSurface) == 1) 
      "\"additive\""
    surfaces <- c(lin, quad, robust, nonpar, additive)
    nsurfaces <- length(surfaces)
    if (nsurfaces > 1) 
      resids <- ""
    ellips <- if (tclvalue(ellipsoid) == 1) 
      "TRUE"
    else "FALSE"
    opts <- options(warn = -1)
    dfNonpar <- if (dfNonpar == gettextRcmdr("<auto>")) 
      ""
    else paste(", df.smooth=", as.numeric(dfNonpar), sep = "")
    dfAdd <- if (dfAdd == gettextRcmdr("<auto>")) 
      ""
    else paste(", df.additive=", as.numeric(dfAdd), sep = "")
    options(opts)
    fit <- if (nsurfaces == 0) 
      ", surface=FALSE"
    else if (nsurfaces == 1) 
      paste(", fit=", surfaces, sep = "")
    else paste(", fit=c(", paste(surfaces, collapse = ","), 
               ")", sep = "")
    .activeDataSet <- ActiveDataSet()
    if (.groups != FALSE) {
      groups <- paste(", groups=", .activeDataSet, "$", 
                      .groups, sep = "")
      parallel <- paste(", parallel=", .linesByGroup, sep = "")
    }
    else parallel <- groups <- ""
    revolutions <- if (rotations != "0") paste(", revolutions =", rotations) else ""
    if (identify == "mouse"){
      RcmdrTkmessageBox(title="Identify Points",
                        message=gettextRcmdr("Drag right mouse button to identify points,\nclick right button to exit."),
                        icon="info", type="ok")
    }
    if (.groups == FALSE) {
      command <- paste("scatter3d(", y, "~", x[1], "+", x[2], ", data=", .activeDataSet, 
                       fit, resids, dfNonpar, dfAdd, 
                       parallel, ", bg=\"", bg, "\", axis.scales=", scales, 
                       ", grid=", grid, ", ellipsoid=", ellips, identify.text, revolutions,
                       ")", sep = "")
      if (identify == "mouse") command <- suppressMarkdown(command)
      doItAndPrint(command)
    }
    else {
      command <- paste("scatter3d(", y, "~", x[1], "+", x[2], "|", .groups, ", data=", .activeDataSet, 
                       fit, resids, dfNonpar, dfAdd, 
                       parallel, ", bg=\"", bg, "\", axis.scales=", scales, 
                       ", grid=", grid, ", ellipsoid=", ellips, identify.text, revolutions,
                       ")", sep = "")
      if (identify == "mouse") command <- suppressMarkdown(command)
      doItAndPrint(command)
    }
    putRcmdr("rgl", TRUE)
    command <- paste("Identify3d(", .activeDataSet, "$", 
                     x[1], ", ", .activeDataSet, "$", y, ", ", .activeDataSet, 
                     "$", x[2], groups, ", axis.scales=", scales, ", labels=row.names(", 
                     .activeDataSet, "))", sep = "")
    putRcmdr("Identify3d", command)
    .Tcl("update")
    activateMenus()
    tkfocus(CommanderWindow())
    rgl.bringtotop()
  }
  groupsBox(Scatter3D, plotLinesByGroup = TRUE, plotLinesByGroupsText = gettextRcmdr("Parallel regression surfaces"),
            initialGroup=initial.group, initialLinesByGroup=dialog.values$initial.lines.by.group,
            initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups") else paste(gettextRcmdr("Plot by:"), initial.group),
            window=dataTab)
  OKCancelHelp(helpSubject = "Scatter3DDialog", reset = "Scatter3D", apply = "Scatter3D")
  tkgrid(getFrame(xBox), labelRcmdr(variablesFrame, text = "  "), 
         getFrame(yBox), sticky = "nw")
  tkgrid(variablesFrame, sticky = "nw")
  tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Number of automatic rotations  ")), 
         rotationsSpinner, sticky="w")
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Show axis scales")), 
         axisScalesCheckBox, sticky = "w")
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Show surface grid lines")), 
         gridLinesCheckBox, sticky = "w")
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Show squared residuals")), 
         squaredResidualsCheckBox, sticky = "w")
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Surfaces to Fit"), 
                    fg = getRcmdr("title.color"), font="RcmdrTitleFont"), sticky = "w")
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Linear least-squares")), 
         linearLSCheckBox, sticky = "w")
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Quadratic least-squares")), 
         quadLSCheckBox, sticky = "w")
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Robust linear regression")), 
         robustCheckBox, sticky = "w")
  dfLabel <- labelRcmdr(surfacesFrame, text = gettextRcmdr("df = "))
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Smooth regression")), 
         nonparCheckBox, dfLabel, dfNonparField, sticky = "w")
  tkgrid.configure(dfLabel, sticky = "e")
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Additive regression")), 
         additiveCheckBox, labelRcmdr(surfacesFrame, text = gettextRcmdr("df(each term) = ")), 
         dfAddField, sticky = "w")
  tkgrid(labelRcmdr(surfacesFrame, text = gettextRcmdr("Plot 50% concentration ellipsoid")), 
         ellipsoidCheckBox, sticky = "w")
  tkgrid(surfacesFrame, sticky = "w")
  tkgrid(labelRcmdr(bgFrame, text = gettextRcmdr("Background Color"), 
                    fg = getRcmdr("title.color"), font="RcmdrTitleFont"), sticky = "w", columnspan = 2)
  tkgrid(labelRcmdr(bgFrame, text = gettextRcmdr("Black")), 
         blackButton, sticky = "w")
  tkgrid(labelRcmdr(bgFrame, text = gettextRcmdr("White")), 
         whiteButton, sticky = "w")
  tkgrid(bgFrame, sticky = "w")
  tkgrid(identifyFrame, sticky="w")
  tkgrid(labelRcmdr(idFrame, text=gettextRcmdr("Number of points to identify  ")), npointsSpinner, sticky="w")
  tkgrid(idFrame, sticky="w")
  tkgrid(groupsFrame, sticky = "w")
  dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

Identify3D <- function(){
    if (0 == rgl.cur()) {
        Message(message=gettextRcmdr("There is no current RGL graphics device."),
            type="error")
        return()
    }
    RcmdrTkmessageBox(title="Identify Points",
        message=gettextRcmdr("Drag right mouse button to identify points,\nclick right button to exit."),
        icon="info", type="ok")
    command <- getRcmdr("Identify3d")
    command <- suppressMarkdown(command)
    doItAndPrint(command)
}

saveBitmap <- function () {
    env <- environment()
    updateWidth <- function(...){
        if (tclvalue(aspectVariable) == "1"){
            tclvalue(heightVariable) <- round(aspect*as.numeric(tclvalue(widthVariable)))
        }
    }
    updateHeight <- function(...){
        if (tclvalue(aspectVariable) == "1"){
            tclvalue(widthVariable) <- round((1/aspect)*as.numeric(tclvalue(heightVariable)))
        }
    }
    updateSize <- function(...){
        units <- tclvalue(unitsVariable)
        size <- dev.size(units=units)
        if (units == "in") {
            wmin <- min(3, size[1])
            wmax <- max(10, size[1])
            hmin <- min(3, size[2])
            hmax <- max(10, size[2])
            rmin <- 50
            rmax <- 300
            res <- if (tclvalue(resVariable) == "72") 72 else round(2.54*as.numeric(tclvalue(resVariable)))
        }
        else if (units == "cm") {
            wmin <- min(8, size[1])
            wmax <- max(25, size[1])
            hmin <- min(8, size[2])
            hmax <- max(25, size[2])
            rmin <- 20
            rmax <- 120
            res <- round(as.numeric(tclvalue(resVariable))/2.54)
        }
        else {
            wmin <- min(200, size[1])
            wmax <- max(1000, size[1])
            hmin <- min(200, size[2])
            hmax <- max(1000, size[2])
            rmin <- 50
            rmax <- 300
            res <- 72
        }
        tkconfigure(widthSlider, from = wmin, to = wmax)
        tkconfigure(heightSlider,  from = hmin, to = hmax)
        tkconfigure(wlabel, text = paste(gettextRcmdr(c("Width", " (", all.units[units], ")")), collapse=""))
        tkconfigure(hlabel, text = paste(gettextRcmdr(c("Height",  " (", all.units[units], ")")), collapse=""))
        tkconfigure(rlabel, text = paste(gettextRcmdr(c("Resolution (pixels/", unit[units], ")")), collapse=""))
        tkconfigure(resSlider, from=rmin, to=rmax, state = if (tclvalue(unitsVariable) == "px") "disabled" else "normal")
        tkconfigure(disabled, text = if (units == "px") gettextRcmdr("[disabled]") else "")
        tclvalue(widthVariable) <- size[1]
        tclvalue(heightVariable) <- size[2]
        tclvalue(resVariable) <- res
    }
    all.units <- c("inches", "cm", "pixels")
    names(all.units) <- c("in", "cm", "px")
    unit <- c("inch", "cm", "inch")
    names(unit) <- c("in", "cm", "px")
    if (1 == dev.cur()) {
        Message(gettextRcmdr("There is no current graphics device to save."), 
            type = "error")
        return()
    }
    defaults <- list (initial.type = "png", initial.pointsize=12, initial.units="in", initial.res = 72)
    dialog.values <- getDialog ("saveBitmap", defaults)
    units <- dialog.values$initial.units
    size <- dev.size(units=units)
    aspect <- size[2]/size[1]
    if (units == "in") {
        wmin <- min(3, size[1])
        wmax <- max(10, size[1])
        hmin <- min(3, size[2])
        hmax <- max(10, size[2])
        rmin <- 50
        rmax <- 300
        res <- dialog.values$initial.res
    }
    else if (units == "cm") {
        wmin <- min(8, size[1])
        wmax <- max(25, size[1])
        hmin <- min(8, size[2])
        hmax <- max(25, size[2])
        rmin <- 20
        rmax <- 120
        res <- dialog.values$initial.res
    }
    else {
        wmin <- min(200, size[1])
        wmax <- max(1000, size[1])
        hmin <- min(200, size[2])
        hmax <- max(1000, size[2])
        rmin <- 50
        rmax <- 300
        res <- 72
    }
    initializeDialog(title = gettextRcmdr("Save Graph as Bitmap"))
    radioButtons(name = "filetype", buttons = c("png", "jpeg"), 
        labels = c("PNG", "JPEG"), title = gettextRcmdr("Graphics File Type"),
        initialValue = dialog.values$initial.type)
    radioButtons(name = "units", buttons = c("in", "cm", "px"), 
        labels = gettextRcmdr(c("inches", "cm", "pixels")), title = gettextRcmdr("Units"),
        initialValue = dialog.values$initial.units, command=updateSize)
    sliderFrame <- tkframe(top)
    widthVariable <- tclVar(size[1])
    widthSlider <- tkscale(sliderFrame, from = wmin, to = wmax, 
        showvalue = TRUE, variable = widthVariable, resolution = 1, 
        orient = "horizontal", command=updateWidth)
    heightVariable <- tclVar(size[2])
    heightSlider <- tkscale(sliderFrame, from = hmin, to = hmax, 
        showvalue = TRUE, variable = heightVariable, resolution = 1, 
        orient = "horizontal", command=updateHeight)
    pointSizeVariable <- tclVar(dialog.values$initial.pointsize)
    pointSizeSlider <- tkscale(sliderFrame, from = 6, to = 16, 
        showvalue = TRUE, variable = pointSizeVariable, resolution = 1, 
        orient = "horizontal")
    resVariable <- tclVar(res)
    resSlider <- tkscale(sliderFrame, from = rmin, to = rmax, 
        showvalue = TRUE, variable = resVariable, resolution = 1, 
        orient = "horizontal")
    tkconfigure(resSlider,  state = if (tclvalue(unitsVariable) == "px") "disabled" else "normal")
    aspectVariable <- tclVar("1")
    aspectFrame <- tkframe(top)
    aspectCheckBox <- ttkcheckbutton(aspectFrame, variable = aspectVariable)
    onOK <- function() {
        closeDialog()
        width <- tclvalue(widthVariable)
        height <- tclvalue(heightVariable)
        type <- tclvalue(filetypeVariable)
        pointsize <- tclvalue(pointSizeVariable)
        units <- tclvalue(unitsVariable)
        res <- tclvalue(resVariable)
        putDialog ("saveBitmap", list (initial.type = type, initial.pointsize = pointsize, initial.units=units, initial.res=res))
        if (type == "png") {
            ext <- "png"
            filetypes <- gettextRcmdr("{\"All Files\" {\"*\"}} {\"PNG Files\" {\".png\" \".PNG\"}}")
            initial <- "RGraph.png"
        }
        else {
            ext <- "jpg"
            filetypes <- gettextRcmdr("{\"All Files\" {\"*\"}} {\"JPEG Files\" {\".jpg\" \".JPG\" \".jpeg\" \".JPEG\"}}")
            initial <- "RGraph.jpg"
        }
        filename <- tclvalue(tkgetSaveFile(filetypes = filetypes, 
            defaultextension = ext, initialfile = initial, parent = CommanderWindow()))
        filename <- removeRedundantExtension(filename)
        if (filename == "") 
            return()
        command <- paste("dev.print(", type, ", filename=\"", 
            filename, "\", width=", width, ", height=", height, ", pointsize=", pointsize, ', units="', units, 
            if(units == "px") '")' else paste('", res=', res, ')', sep=""), sep = "")
        doItAndPrint(command, rmd=FALSE)
        Message(paste(gettextRcmdr("Graph saved to file"), filename), 
            type = "note")
    }
    OKCancelHelp(helpSubject = "png", reset = "saveBitmap")
    tkgrid(filetypeFrame, sticky = "w")
    tkgrid(unitsFrame, stick="w")
    tkgrid(labelRcmdr(aspectFrame, text = gettextRcmdr("Fixed aspect ratio (height:width)")),
        aspectCheckBox, sticky="w")
    tkgrid(aspectFrame, sticky="w")
    tkgrid(wlabel <- labelRcmdr(sliderFrame, text = paste(gettextRcmdr(c("Width", " (", all.units[units], ")")), collapse="")), 
        widthSlider, sticky = "sw")
    tkgrid(hlabel <- labelRcmdr(sliderFrame, text = paste(gettextRcmdr(c("Height",  " (", all.units[units], ")")), collapse="")), 
        heightSlider, sticky = "sw")
    tkgrid(rlabel <- labelRcmdr(sliderFrame, text = paste(gettextRcmdr(c("Resolution", "(", "pixels", "/", unit[units], ")")), collapse="")), 
        resSlider, 
        disabled <- labelRcmdr(sliderFrame, text = if (units == "px") gettextRcmdr("[disabled]") else ""),
        sticky = "sw")
    tkgrid(labelRcmdr(sliderFrame, text = gettextRcmdr("Text size (points)")), 
        pointSizeSlider, sticky = "sw")
    tkgrid(sliderFrame, sticky = "w")
    tkgrid(buttonsFrame, sticky = "w")
    dialogSuffix()
}

savePDF <- function () {
    updateWidth <- function(...){
        if (tclvalue(aspectVariable) == "1"){
            tclvalue(heightVariable) <- round(aspect*as.numeric(tclvalue(widthVariable)), 1)
        }
    }
    updateHeight <- function(...){
        if (tclvalue(aspectVariable) == "1"){
            tclvalue(widthVariable) <- round((1/aspect)*as.numeric(tclvalue(heightVariable)), 1)
        }
    }
    updateSize <- function(...){
        units <- tclvalue(unitsVariable)
        size <- dev.size(units=units)
        if (units == "in") {
            wmin <- min(3, size[1])
            wmax <- max(10, size[1])
            hmin <- min(3, size[2])
            hmax <- max(10, size[2])
        }
        else {
            wmin <- min(8, size[1])
            wmax <- max(25, size[1])
            hmin <- min(8, size[2])
            hmax <- max(25, size[2])
        }
        tkconfigure(widthSlider, from = wmin, to = wmax)
        tkconfigure(heightSlider,  from = hmin, to = hmax)
        tkconfigure(wlabel, text = paste(gettextRcmdr(c("Width", " (", all.units[units], ")")), collapse=""))
        tkconfigure(hlabel, text = paste(gettextRcmdr(c("Height",  " (", all.units[units], ")")), collapse=""))
        tclvalue(widthVariable) <- size[1]
        tclvalue(heightVariable) <- size[2]
    }
    all.units <- c("inches", "cm")
    names(all.units) <- c("in", "cm")
    if (1 == dev.cur()) {
        Message(gettextRcmdr("There is no current graphics device to save."), 
            type = "error")
        return()
    }
    defaults <- list (initial.type = "pdf", initial.pointsize = 12, initial.units="in")
    dialog.values <- getDialog ("savePDF", defaults)
    units <- dialog.values$initial.units
    size <- dev.size(units=units)
    aspect <- size[2]/size[1]
    size <- round(size, 1)
    if (units == "in") {
        wmin <- min(3, size[1])
        wmax <- max(10, size[1])
        hmin <- min(3, size[2])
        hmax <- max(10, size[2])
    }
    else {
        wmin <- min(8, size[1])
        wmax <- max(25, size[1])
        hmin <- min(8, size[2])
        hmax <- max(25, size[2])
    }
    initializeDialog(title = gettextRcmdr("Save Graph as PDF/Postscript"))
    radioButtons(name = "filetype", buttons = c("pdf", "postscript", 
        "eps"), labels = gettextRcmdr(c("PDF", "Postscript", 
            "Encapsulated Postscript")), title = gettextRcmdr("Graphics File Type"), 
        initialValue = dialog.values$initial.type)
    radioButtons(name = "units", buttons = c("in", "cm"), 
        labels = gettextRcmdr(c("inches", "cm")), title = gettextRcmdr("Units"),
        initialValue = dialog.values$initial.units, command=updateSize)
    aspectVariable <- tclVar("1")
    aspectFrame <- tkframe(top)
    aspectCheckBox <- ttkcheckbutton(aspectFrame, variable = aspectVariable)
    sliderFrame <- tkframe(top)
    widthVariable <- tclVar(size[1])
    widthSlider <- tkscale(sliderFrame, from = wmin, to = wmax, 
        showvalue = TRUE, 
        variable = widthVariable, resolution = 0.1, orient = "horizontal", 
        command=updateWidth)
    heightVariable <- tclVar(size[2])
    heightSlider <- tkscale(sliderFrame, from = hmin, to = hmax, 
        showvalue = TRUE, 
        variable = heightVariable, resolution = 0.1, orient = "horizontal",
        command=updateHeight)
    pointSizeVariable <- tclVar(dialog.values$initial.pointsize)
    pointSizeSlider <- tkscale(sliderFrame, from = 6, to = 16, 
        showvalue = TRUE, variable = pointSizeVariable, resolution = 1, 
        orient = "horizontal")
    onOK <- function() {
        closeDialog()
        width <- tclvalue(widthVariable)
        height <- tclvalue(heightVariable)
        type <- tclvalue(filetypeVariable)
        units <- tclvalue(unitsVariable)
        pointsize <- tclvalue(pointSizeVariable)
        putDialog ("savePDF", list (initial.type = type, initial.pointsize = pointsize, initial.units=units))
        if (units == "cm") {
            width <- round(as.numeric(width)/2.54, 1)
            height <- round(as.numeric(height)/2.54, 1)
        } 
        if (type == "pdf") {
            ext <- "pdf"
            filetypes <- gettextRcmdr("{\"All Files\" {\"*\"}} {\"PDF Files\" {\".pdf\" \".PDF\"}}")
            initial <- "RGraph.pdf"
        }
        else if (type == "postscript") {
            ext <- "ps"
            filetypes <- gettextRcmdr("{\"All Files\" {\"*\"}} {\"Postscript Files\" {\".ps\" \".PS\"}}")
            initial <- "RGraph.ps"
        }
        else {
            ext <- "eps"
            filetypes <- gettextRcmdr("{\"All Files\" {\"*\"}} {\"Encapsulated Postscript Files\" {\".eps\" \".EPS\"}}")
            initial <- "RGraph.eps"
        }
        filename <- tclvalue(tkgetSaveFile(filetypes = filetypes, 
            defaultextension = ext, initialfile = initial, parent = CommanderWindow()))
        filename <- removeRedundantExtension(filename)
        if (filename == "") 
            return()
        command <- if (type == "eps") 
            paste("dev.copy2eps(file=\"", filename, "\", width=", 
                width, ", height=", height, ", pointsize=", pointsize, 
                ")", sep = "")
        else paste("dev.print(", type, ", file=\"", filename, 
            "\", width=", width, ", height=", height, ", pointsize=", 
            pointsize, ")", sep = "")
        doItAndPrint(command, rmd=FALSE)
        Message(paste(gettextRcmdr("Graph saved to file"), filename), 
            type = "note")
    }
    OKCancelHelp(helpSubject = "pdf", reset = "savePDF")
    tkgrid(filetypeFrame, sticky = "w")
    tkgrid(unitsFrame, stick="w")
    tkgrid(labelRcmdr(aspectFrame, text = gettextRcmdr("Fixed aspect ratio (height:width)")),
        aspectCheckBox, sticky="w")
    tkgrid(aspectFrame, sticky="w")
    tkgrid(wlabel <- labelRcmdr(sliderFrame, text = paste(gettextRcmdr(c("Width", " (", all.units[units], ")")), collapse="")), 
        widthSlider, sticky = "sw")
    tkgrid(hlabel <- labelRcmdr(sliderFrame, text = paste(gettextRcmdr(c("Height",  " (", all.units[units], ")")), collapse="")), 
        heightSlider, sticky = "sw")
    tkgrid(labelRcmdr(sliderFrame, text = gettextRcmdr("Text size (points)")), 
        pointSizeSlider, sticky = "sw")
    tkgrid(sliderFrame, sticky = "w")
    tkgrid(buttonsFrame, sticky = "w")
    dialogSuffix()
}

saveRglGraph <- function(){
    if (0 == rgl.cur()) {
        Message(message=gettextRcmdr("There is no current RGL graphics device to save."),
            type="error")
        return()
    }
    ext <- "png"
    filetypes <- gettextRcmdr('{"All Files" {"*"}} {"PNG Files" {".png" ".PNG"}}')
    initial <- "RGLGraph.png"
    filename <- tclvalue(tkgetSaveFile(filetypes=filetypes,
        defaultextension=ext,
        initialfile=initial,
        parent=CommanderWindow()))
    filename <- removeRedundantExtension(filename)
    if (filename == "") return()
    command <- paste('rgl.snapshot("', filename, '")', sep="")
    doItAndPrint(command, rmd=FALSE)
    Message(paste(gettextRcmdr("Graph saved to file"), filename), type="note")
}

## The following function by Richard Heiberger, with small modifications by J. Fox
## with more modifications by Richard Heiberger.
## 2008-01-03 added conditions, layout, and multiple colors
## 2012-08-19 rmh added memory to the dialogs, using John Fox's getDialog and putDialog functions
## 2013-06-19 J. Fox added Data and Options tabs, Apply button

Xyplot <- function() {
    Library("lattice")
    defaults <- list(initial.predictor = NULL, initial.response = NULL,
        initial.auto.key = 1, initial.outer = 0,
        initial.x.relation = "same", initial.y.relation = "same",
        initial.layoutColumns = "", initial.layoutRows = "",
        initial.conditions = FALSE,
        initial.groups = FALSE,
        initial.points = 1, initial.lines = 0, initial.tab=0,
        initial.xlab=gettextRcmdr("<auto>"), initial.ylab=gettextRcmdr("<auto>"),
        initial.main=gettextRcmdr("<auto>"))
    dialog.values <- getDialog("Xyplot", defaults)
    initializeDialog(title=gettextRcmdr("XY Conditioning Plot"), use.tabs=TRUE)
    predictorFrame <- tkframe(dataTab)
    predictorBox <-
        variableListBox(predictorFrame, Numeric(),
            title=gettextRcmdr("Explanatory variables (pick one or more)"),
            selectmode="multiple",
            initialSelection = varPosn (dialog.values$initial.predictor, "numeric"))
    responseBox <- variableListBox(predictorFrame, Numeric(),
        title=gettextRcmdr("Response variables (pick one or more)"),
        selectmode="multiple",
        initialSelection = varPosn (dialog.values$initial.response, "numeric"))
    cgFrame <- tkframe(dataTab)
    conditions.if <-
        length(dialog.values$initial.conditions) == 1 &&
        dialog.values$initial.conditions == FALSE
    conditionsBox <- variableListBox(cgFrame, Factors(),
        title=gettextRcmdr("Conditions '|' (pick zero or more)"),
        selectmode="multiple",
        initialSelection=if (conditions.if) FALSE else
            varPosn(dialog.values$initial.conditions, "factor"))
    groups.if <-
        length(dialog.values$initial.groups) == 1 &&
        dialog.values$initial.groups == FALSE
    groupsBox <- variableListBox(cgFrame, Factors(),
        title=gettextRcmdr("Groups 'groups=' (pick zero or more)"),
        selectmode="multiple",
        initialSelection=if (groups.if) FALSE else
            varPosn(dialog.values$initial.groups, "factor"))
    optionsFrame <- tkframe(optionsTab)
    optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Options"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    checkBoxes(window = optFrame, frame="otherFrame",
        boxes=c("auto.key", "outer"),
        initialValues=c(dialog.values$initial.auto.key, dialog.values$initial.outer),
        labels=gettextRcmdr(c("Automatically draw key",
            "Different panels for different y ~ x combinations")))
    relationFrame <- tkframe(optFrame)
    radioButtons(window=relationFrame,
        name="x.relation",
        buttons=c("same", "free", "sliced"),
        labels=gettextRcmdr(c("Identical", "Free", "Same range")),
        title=gettextRcmdr("X-Axis Scales in Different Panels"),
        initialValue = dialog.values$initial.x.relation)
    radioButtons(window=relationFrame,
        name="y.relation",
        buttons=c("same", "free", "sliced"),
        labels=gettextRcmdr(c("Identical", "Free", "Same range")),
        title=gettextRcmdr("Y-Axis Scales in Different Panels"),
        initialValue = dialog.values$initial.y.relation)
    
    scalarsFrame <- tkframe(optFrame)
    layoutColumnsVar <- tclVar(dialog.values$initial.layoutColumns)
    layoutColumnsEntry <- tkentry(scalarsFrame, width="6", textvariable=layoutColumnsVar)
    layoutRowsVar <- tclVar(dialog.values$initial.layoutRows)
    layoutRowsEntry <- tkentry(scalarsFrame, width="6", textvariable=layoutRowsVar)
    
    checkBoxes(window = optFrame, frame="typeFrame",
        boxes=c("points", "lines"),
        initialValues=c(dialog.values$initial.points, dialog.values$initial.lines),
        labels=gettextRcmdr(c("Points", "Lines")))
    xlabVar <- tclVar(dialog.values$initial.xlab)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        predictor <- getSelection(predictorBox)
        response <- getSelection(responseBox)
        conditions <- getSelection(conditionsBox)
        groups <- getSelection(groupsBox)
        closeDialog()
        
        if (0 == length(response)) {
            errorCondition(recall=Xyplot,
                message=gettextRcmdr("At least one response variable must be selected."))
            return()
        }
        if (0 == length(predictor)) {
            errorCondition(recall=Xyplot,
                message=gettextRcmdr("At least one explanatory variable must be selected."))
            return()
        }
        auto.key <- ("1" == tclvalue(auto.keyVariable))
        outer    <- ("1" == tclvalue(outerVariable))
        x.relation <- as.character(tclvalue(x.relationVariable))
        y.relation <- as.character(tclvalue(y.relationVariable))
        
        layoutColumns  <- as.numeric(tclvalue(layoutColumnsVar))
        layoutRows     <- as.numeric(tclvalue(layoutRowsVar))
        
        points <- ("1" == tclvalue(pointsVariable))
        lines  <- ("1" == tclvalue(linesVariable))
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if (xlab == gettextRcmdr("<auto>"))
            ""
        else paste(", xlab=\"", xlab, "\"", sep = "")
        ylab <- trim.blanks(tclvalue(ylabVar))
        ylab <- if (ylab == gettextRcmdr("<auto>"))
            ""
        else paste(", ylab=\"", ylab, "\"", sep = "")
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            ""
        else paste(", main=\"", main, "\"", sep = "")
        putDialog ("Xyplot", list(initial.predictor = predictor, initial.response = response,
            initial.auto.key = auto.key, initial.outer = outer,
            initial.x.relation = x.relation,
            initial.y.relation = y.relation,
            initial.layoutColumns = tclvalue(layoutColumnsVar),
            initial.layoutRows = tclvalue(layoutRowsVar),
            initial.conditions = if (length(conditions) != 0) conditions else FALSE,
            initial.groups = if (length(groups) != 0) groups else FALSE,
            initial.points = points,
            initial.lines = lines,
            initial.tab=tab, initial.xlab=tclvalue(xlabVar),
            initial.ylab=tclvalue(ylabVar), initial.main=tclvalue(mainVar)))
        
        layout.command <- ""
        number.na <- is.na(layoutColumns) + is.na(layoutRows)
        
        if (number.na==1) {
            errorCondition(recall=Xyplot,
                message=gettextRcmdr("Both or neither layout values must be numbers."))
            return()
        }
        if (number.na==0) layout.command <- deparse(c(layoutColumns, layoutRows))
        
        .activeDataSet <- ActiveDataSet()
        
        
        
        conditions.command <-
            if (length(conditions) == 0) {
                if (outer) {
                    if (layout.command == "")
                        paste(", layout=c(",
                            length(predictor),
                            ",",
                            length(response),
                            ")")
                    else
                        paste(", layout=", layout.command, sep="")
                }
                else
                    if (layout.command != "")
                        paste(", layout=", layout.command, sep="")
            }
        else {  ## (length(conditions) > 0)
            if (outer) {
                condition.levels <- prod(sapply(conditions, d.f=get(.activeDataSet),
                    function(g, d.f) length(levels(d.f[[g]]))))
                if (layout.command != "")
                    paste(", layout=", layout.command, sep="")
                else
                    paste(", layout=c(",
                        condition.levels,
                        "*",
                        length(predictor),
                        ",",
                        length(response),
                        ")",
                        ## ", between=list(x=c(0,0, 1, 0,0), y=1)",
                        ", between=list(x=c(",
                        paste(rep(c(rep(0, condition.levels-1), 1),
                            length=condition.levels*length(predictor)-1),
                            collapse=","),
                        "), y=1)")
            }
            else
                if (layout.command != "")
                    paste(", layout=", layout.command, sep="")
        }
        
        
        groups.command <- switch(as.character(length(groups)),
            "0"="",
            "1"=paste(", groups=", groups, sep=""),
            paste(", groups=interaction(",
                paste(groups, collapse=","),
                ")", sep=""))
        
        if(!(points || lines)) {
            errorCondition(recall=Xyplot,
                message=gettextRcmdr("Choose at least one of points or lines."))
            return()
        }
        
        type.command <- paste(", type=",
            deparse(c("p"[points], "l"[lines])),
            sep="")
        
        xyplot.command <- paste("xyplot(",
            paste(response, collapse=" + "),
            " ~ ",
            paste(predictor, collapse=" + "),
            if (length(conditions) > 0)
                paste(" |",
                    paste(conditions, collapse=" + ")
                ) else "",
            if (outer) ", outer=TRUE",
            conditions.command,
            groups.command,
            type.command,
            ", pch=16",
            if (auto.key) ", auto.key=list(border=TRUE), par.settings=simpleTheme(pch=16)" else "",
            paste(", scales=list(x=list(relation='",
                x.relation,
                "'), y=list(relation='",
                y.relation,
                "'))", sep=""),
            ", data=", .activeDataSet, xlab, ylab, main, ")", sep="")
        doItAndPrint(xyplot.command)
        activateMenus()
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="xyplot", reset = "Xyplot", apply = "Xyplot")
    tkgrid(getFrame(predictorBox), getFrame(responseBox),
        columnspan=1, sticky="w")
    tkgrid(predictorFrame, sticky="w")
    tkgrid(getFrame(conditionsBox),
        tklabel(cgFrame, text=gettextRcmdr("           ")),
        getFrame(groupsBox),
        columnspan=1, sticky="w")
    tkgrid(cgFrame, sticky="w")
    tkgrid(tklabel(optFrame, text=gettextRcmdr("Other Options"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
    tkgrid(otherFrame, sticky="w")
    tkgrid(tklabel(optFrame, text=gettextRcmdr("Plot Type (one or both)"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
    tkgrid(typeFrame, sticky="w")
    
    tkgrid(x.relationFrame, y.relationFrame, columnspan=2, sticky="w")
    tkgrid(relationFrame, sticky="w")
    
    tkgrid(tklabel(optFrame, text=gettextRcmdr("Layout"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"),
        sticky="w")
    tkgrid(tklabel(scalarsFrame, text=gettextRcmdr("number of columns:")), layoutColumnsEntry, sticky="w")
    tkgrid(tklabel(scalarsFrame, text=gettextRcmdr("number of rows:")), layoutRowsEntry, sticky="w")
    tkgrid(scalarsFrame, sticky="w")
    tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
    tkgrid(optionsFrame, sticky = "w")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

# set the colour palette

# some unexported functions for dealing with colors

pickColor <- function(initialcolor, parent){
    newcolor <- tclvalue(.Tcl(paste("tk_chooseColor", .Tcl.args(title = "Select a Color",
                                                                initialcolor=initialcolor, parent=parent))))
    newcolor <- toupper(newcolor)
    if (newcolor == "") initialcolor else newcolor
}

# the following local function from Thomas Lumley via r-help
convert <- function (color){
    rgb <- col2rgb(color)/255
    L <- c(0.2, 0.6, 0) %*% rgb
    ifelse(L >= 0.2, "#000060", "#FFFFA0")
}

col2hex <- function(col){
    hexcolor <- colorConverter(toXYZ = function(hex,...) {
        rgb <- t(col2rgb(hex))/255
        colorspaces$sRGB$toXYZ(rgb,...) },
        fromXYZ = function(xyz,...) {
            rgb <- colorspaces$sRGB$fromXYZ(xyz,...)
            rgb <- round(rgb,5)
            if (min(rgb) < 0 || max(rgb) > 1) as.character(NA)
            else rgb(rgb[1],rgb[2],rgb[3])},
        white = "D65", name = "#rrggbb")
    cols <- t(col2rgb(col))
    convertColor(cols, from="sRGB", to=hexcolor, scale.in=255, scale.out=NULL)
}

setPalette <- function() {
    env <- environment()
    initializeDialog(title=gettextRcmdr("Set Color Palette"))
    hex <- col2hex(palette())
    for (i in 1:8) assign(paste("hex", i, sep="."), hex[i], envir=env)
    paletteFrame <- tkframe(top)
    colorField1 <- labelRcmdr(paletteFrame, text=rgb2col(hex[1]), fg=hex[1])
    button1 <- tkbutton(paletteFrame, text=hex[1], bg = hex[1],
        fg=convert(hex[1]),
        command=function() {
            color <- pickColor(hex[1], parent=button1)
            fg <- convert(color)
            tkconfigure(button1, bg=color, fg=fg, text=toupper(color))
            tkconfigure(colorField1, text=rgb2col(color), foreground=color)
            assign("hex.1", color, envir=env)
        }
    )
    colorField2 <- labelRcmdr(paletteFrame, text=rgb2col(hex[2]), fg=hex[2])
    button2 <- tkbutton(paletteFrame, text=hex[2], bg = hex[2],
        fg=convert(hex[2]),
        command=function() {
            color <- pickColor(hex[2], parent=button2)
            fg <- convert(color)
            tkconfigure(button2, bg=color, fg=fg, text=toupper(color))
            tkconfigure(colorField2, text=rgb2col(color), foreground=color)
            assign("hex.2", color, envir=env)
        }
    )
    colorField3 <- labelRcmdr(paletteFrame, text=rgb2col(hex[3]), fg=hex[3])
    button3 <- tkbutton(paletteFrame, text=hex[3], bg = hex[3],
        fg=convert(hex[3]),
        command=function() {
            color <- pickColor(hex[3], parent=button3)
            fg <- convert(color)
            tkconfigure(button3, bg=color, fg=fg, text=toupper(color))
            tkconfigure(colorField3, text=rgb2col(color), foreground=color)
            assign("hex.3", color, envir=env)
        }
    )
    colorField4 <- labelRcmdr(paletteFrame, text=rgb2col(hex[4]), fg=hex[4])
    button4 <- tkbutton(paletteFrame, text=hex[4], bg = hex[4],
        fg=convert(hex[4]),
        command=function() {
            color <- pickColor(hex[4], parent=button4)
            fg <- convert(color)
            tkconfigure(button4, bg=color, fg=fg, text=toupper(color))
            tkconfigure(colorField4, text=rgb2col(color), foreground=color)
            assign("hex.4", color, envir=env)
        }
    )
    colorField5 <- labelRcmdr(paletteFrame, text=rgb2col(hex[5]), fg=hex[5])
    button5 <- tkbutton(paletteFrame, text=hex[5], bg = hex[5],
        fg=convert(hex[5]),
        command=function() {
            color <- pickColor(hex[5], parent=button5)
            fg <- convert(color)
            tkconfigure(button5, bg=color, fg=fg, text=toupper(color))
            tkconfigure(colorField5, text=rgb2col(color), foreground=color)
            assign("hex.5", color, envir=env)
        }
    )
    colorField6 <- labelRcmdr(paletteFrame, text=rgb2col(hex[6]), fg=hex[6])
    button6 <- tkbutton(paletteFrame, text=hex[6], bg = hex[6],
        fg=convert(hex[6]),
        command=function() {
            color <- pickColor(hex[6], parent=button6)
            fg <- convert(color)
            tkconfigure(button6, bg=color, fg=fg, text=toupper(color))
            tkconfigure(colorField6, text=rgb2col(color), foreground=color)
            assign("hex.6", color, envir=env)
        }
    )
    colorField7 <- labelRcmdr(paletteFrame, text=rgb2col(hex[7]), fg=hex[7])
    button7 <- tkbutton(paletteFrame, text=hex[7], bg = hex[7],
        fg=convert(hex[7]),
        command=function() {
            color <- pickColor(hex[7], parent=button7)
            fg <- convert(color)
            tkconfigure(button7, bg=color, fg=fg, text=toupper(color))
            tkconfigure(colorField7, text=rgb2col(color), foreground=color)
            assign("hex.7", color, envir=env)
        }
    )
    colorField8 <- labelRcmdr(paletteFrame, text=rgb2col(hex[8]), fg=hex[8])
    button8 <- tkbutton(paletteFrame, text=hex[8], bg = hex[8],
        fg=convert(hex[8]),
        command=function() {
            color <- pickColor(hex[8], parent=button8)
            fg <- convert(color)
            tkconfigure(button8, bg=color, fg=fg, text=toupper(color))
            tkconfigure(colorField8, text=rgb2col(color), foreground=color)
            assign("hex.8", color, envir=env)
        }
    )
    onOK <- function(){
        closeDialog(top)
        palette(c(hex.1, hex.2, hex.3, hex.4, hex.5, hex.6, hex.7, hex.8))
        Message(gettextRcmdr("Color palette reset.", type="note"))
    }
    OKCancelHelp(helpSubject="palette")
    tkgrid(button1, button2, button3, button4, button5, button6, button7, button8)
    tkgrid(colorField1, colorField2, colorField3, colorField4, colorField5, 
        colorField6, colorField7, colorField8)
    tkgrid(paletteFrame)
    tkgrid(buttonsFrame, sticky="ew")
    dialogSuffix()
}

stripChart <- function () {
    defaults <- list (initial.group = NULL, initial.response = NULL, initial.plotType = "stack",
        initial.xlab=gettextRcmdr("<auto>"), initial.ylab=gettextRcmdr("<auto>"), 
        initial.main=gettextRcmdr("<auto>"), initial.tab=0)
    dialog.values <- getDialog("stripChart", defaults)
    initializeDialog(title = gettextRcmdr("Strip Chart"), use.tabs=TRUE)
    groupBox <- variableListBox(dataTab, Factors(), title = gettextRcmdr("Factors (pick zero or more)"),
        selectmode = "multiple", initialSelection = varPosn (dialog.values$initial.group, "factor"))
    responseBox <- variableListBox(dataTab, Numeric(), title = gettextRcmdr("Response Variable (pick one)"),
        initialSelection = varPosn (dialog.values$initial.response, "numeric"))
    optionsFrame <- tkframe(optionsTab)
    optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Duplicate Values"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
        font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    xlabVar <- tclVar(dialog.values$initial.xlab)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
        command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
        ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        groups <- getSelection(groupBox)
        response <- getSelection(responseBox)
        closeDialog()
        if (0 == length(response)) {
            errorCondition(recall = stripChart, message = gettextRcmdr("No response variable selected."))
            return()
        }
        .activeDataSet <- ActiveDataSet()
        plotType <- tclvalue(plotTypeVariable)
        
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            ""
        else paste(", main=\"", main, "\"", sep = "")
        putDialog ("stripChart", list (initial.group = groups, initial.response = response,
            initial.plotType = plotType, initial.xlab=tclvalue(xlabVar),
            initial.ylab=tclvalue(ylabVar), initial.main=tclvalue(mainVar),
            initial.tab=tab))
        method <- paste(", method=\"", plotType, "\"", sep = "")
        if (length(groups) == 0) {
            xlab <- trim.blanks(tclvalue(xlabVar))
            xlab <- if (xlab == gettextRcmdr("<auto>"))
                paste(", xlab=\"", response, "\"", sep = "")
            else paste(", xlab=\"", xlab, "\"", sep = "")
            ylab <- trim.blanks(tclvalue(ylabVar))
            ylab <- if (ylab == gettextRcmdr("<auto>"))
                ""
            else paste(", ylab=\"", ylab, "\"", sep = "")
            doItAndPrint(paste("stripchart(", .activeDataSet,
                "$", response, method, xlab, ylab, main, ")", sep = ""))
        }
        else {
            groupNames <- paste(groups, collapse = "*")
            xlab <- trim.blanks(tclvalue(xlabVar))
            xlab <- if (xlab == gettextRcmdr("<auto>"))
                ""
            else paste(", xlab=\"", xlab, "\"", sep = "")
            ylab <- trim.blanks(tclvalue(ylabVar))
            ylab <- if (ylab == gettextRcmdr("<auto>"))
                paste(", ylab=\"", response, "\"", sep = "")
            else paste(", ylab=\"", ylab, "\"", sep = "")
            doItAndPrint(paste("stripchart(", response, " ~ ",
                groupNames, ", vertical=TRUE", method, xlab, ylab, main, ", data=",
                .activeDataSet, ")", sep = ""))
        }
        activateMenus()
        tkfocus(CommanderWindow())
    }
    plotFrame <- tkframe(optFrame)
    radioButtons(window = plotFrame, name = "plotType", buttons = c("stack", "jitter"),
        labels = gettextRcmdr(c("Stack", "Jitter")), title = "",
        initialValue = dialog.values$initial.plotType)
    OKCancelHelp(helpSubject = "stripchart", reset = "stripChart", apply = "stripChart")
    tkgrid(getFrame(groupBox), getFrame(responseBox), sticky = "nw")
    tkgrid(plotTypeFrame, sticky = "w")
    tkgrid(plotFrame, sticky = "w")
    tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
    tkgrid(optionsFrame, sticky = "w")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

DensityPlot <- function () {
  defaults <- list(initial.x = NULL, initial.bw = gettextRcmdr("<auto>"),
                   initial.kernel="gaussian", initial.adjust=1, initial.method="adaptive",
                   initial.from=gettextRcmdr("<auto>"), initial.to=gettextRcmdr("<auto>"),
                   initial.group=NULL, initial.tab=0,
                   initial.xlab=gettextRcmdr("<auto>"), initial.ylab=gettextRcmdr("<auto>"))
  dialog.values <- getDialog("DensityPlot", defaults)
  initializeDialog(title = gettextRcmdr("Nonparametric Density Estimate"), use.tabs=TRUE)
  xBox <- variableListBox(dataTab, Numeric(), title = gettextRcmdr("Variable (pick one)"),
                          initialSelection = varPosn (dialog.values$initial.x, "numeric"))
  optionsFrame <- tkframe(optionsTab)
  optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Kernel Function"),
                                                              font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
  parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
                                                              font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
  kerFrame <- tkframe(optFrame)
  radioButtons(kerFrame, name = "kernel", buttons = c("gaussian", "epanechnikov", "biweight"),
               labels = gettextRcmdr(c("Gaussian", "Epanechnikov", "Tukey biweight")),
               initialValue = dialog.values$initial.kernel)
  radioButtons(optionsFrame, name="method", buttons=c("adaptive", "kernel"),
                labels=gettextRcmdr(c("adaptive kernel", "kernel")), 
                title=gettextRcmdr("Method"),
                initialValue=dialog.values$initial.method)
  bwFrame <- tkframe(optFrame)
  bwVariable <- tclVar(dialog.values$initial.bw)
  bwField <- ttkentry(bwFrame, width = "8", textvariable = bwVariable)
  adjustVariable <- tclVar(dialog.values$initial.adjust)
  adjustSlider <- tkscale(bwFrame, from = 0.1, to = 10, showvalue = TRUE,
                          variable = adjustVariable, resolution = 0.1, orient = "horizontal")
  rangeFrame <- tkframe(optionsFrame)
  fromVar <- tclVar(dialog.values$initial.from)
  fromEntry <- ttkentry(rangeFrame, width = "10", textvariable = fromVar)
  toVar <- tclVar(dialog.values$initial.to)
  toEntry <- ttkentry(rangeFrame, width = "10", textvariable = toVar)
  initial.group <- dialog.values$initial.group
  .groups <- if (is.null(initial.group)) FALSE else initial.group
  xlabVar <- tclVar(dialog.values$initial.xlab)
  ylabVar <- tclVar(dialog.values$initial.ylab)
  xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
  xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                             command = function(...) tkxview(xlabEntry, ...))
  tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
                                                              ...))
  tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
  tkgrid(labelRcmdr(parFrame, text=""), xlabScroll, sticky = "ew", padx=6)
  ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
  ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                             command = function(...) tkxview(ylabEntry, ...))
  tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
                                                              ...))
  tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
  tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
  onOK <- function() {
    tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
    x <- getSelection(xBox)
    kernel <- tclvalue(kernelVariable)
    adjust <- tclvalue(adjustVariable)
    bw <- tclvalue(bwVariable)
    method <- tclvalue(methodVariable)
    fromValue <- trim.blanks(tclvalue(fromVar))
    toValue <- trim.blanks(tclvalue(toVar))
    if (length(x) == 0) {
      errorCondition(recall = DensityPlot, message = gettextRcmdr("You must select a variable"))
      return()
    }
    if (bw != gettextRcmdr("<auto>")){
      test.bw <- suppressWarnings(as.numeric(bw))
      if (is.na(test.bw) || test.bw <= 0){
        errorCondition(recall = DensityPlot,
                       message = gettextRcmdr("Bandwidth must be <auto> or a positive number"))
        return()
      }
    }
    from <- if (fromValue == gettextRcmdr("<auto>")) "" else paste0(", from=", fromValue)
    to <- if (fromValue == gettextRcmdr("<auto>")) "" else paste0(", to=", toValue)
    xlab <- trim.blanks(tclvalue(xlabVar))
    xlab <- if (xlab == gettextRcmdr("<auto>"))
      ""
    else paste(", xlab=\"", xlab, "\"", sep = "")
    ylab <- trim.blanks(tclvalue(ylabVar))
    ylab <- if (ylab == gettextRcmdr("<auto>"))
      ""
    else paste(", ylab=\"", ylab, "\"", sep = "")
    putDialog ("DensityPlot", list(initial.x = x, initial.bw = bw, initial.kernel=kernel,
      initial.adjust=adjust, initial.method=method,
      initial.from=fromValue, initial.to=toValue,
      initial.group=if (.groups == FALSE) NULL else .groups,
      initial.tab=tab, initial.xlab=tclvalue(xlabVar),
      initial.ylab=tclvalue(ylabVar)))
    if (bw == gettextRcmdr("<auto>")) bw  <- if (method == "adaptive")  "bw.SJ" else '"SJ"'
    closeDialog()
    .activeDataSet <- ActiveDataSet()
    var <- paste(.activeDataSet, "$", x, sep = "")
    kernel.selector <- if (method == "adaptive"){
      switch(kernel,
        gaussian = "dnorm",
        epanechnikov = "depan",
        biweight = "dbiwt"
      )}
      else paste0('"', kernel, '"')
      
    if (is.null(.groups) || .groups == FALSE) {
      command <- paste('densityPlot( ~ ', x,  ', data=', .activeDataSet, ', bw=', bw,
                       ", adjust=", adjust, ', kernel=', kernel.selector, '',
                       ', method="', method, '"', from, to, xlab, ylab, ')', sep="")
      doItAndPrint(command)
    }
    else {
      command <- paste("densityPlot(", x, "~", .groups, ', data=',
                       .activeDataSet, ', bw=', bw,
                       ", adjust=", adjust, ', kernel=', kernel.selector, '',
                       ', method="', method, '"',
                       from, to, xlab, ylab, ')', sep="")
      doItAndPrint(command)
    }
    activateMenus()
    tkfocus(CommanderWindow())
  }
  groupsBox(DensityPlot, initialGroup=initial.group,
            initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups")
            else paste(gettextRcmdr("Plot by:"), initial.group),
            window=dataTab)
  OKCancelHelp(helpSubject = "densityPlot", reset = "DensityPlot", apply="DensityPlot")
  tkgrid(getFrame(xBox), sticky = "nw")
  tkgrid(groupsFrame, sticky = "w")
  tkgrid(kernelFrame, stick = "w")
  tkgrid(kerFrame, sticky="w")
  tkgrid(labelRcmdr(bwFrame, text = gettextRcmdr("Bandwidth")), bwField,
         labelRcmdr(bwFrame, text = gettextRcmdr("Multiply bandwidth by")),
         adjustSlider, sticky = "swe", padx=6)
  tkgrid(bwFrame, sticky="sw")
  tkgrid(methodFrame, sticky="w")
  tkgrid(labelRcmdr(rangeFrame, text=gettextRcmdr("From")), fromEntry, sticky="w")
  tkgrid(labelRcmdr(rangeFrame, text=gettextRcmdr("To")), toEntry, sticky="w")
  tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
  tkgrid(rangeFrame, sticky="w")
  tkgrid(optionsFrame, sticky = "w")
  dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

DiscretePlot <- function () {
    defaults <- list(initial.x = NULL, initial.scale = "frequency",
                     initial.tab=0,
                     initial.xlab=gettextRcmdr("<auto>"), initial.ylab=gettextRcmdr("<auto>"),
                     initial.main=gettextRcmdr("<auto>"), initial.group = NULL)
    dialog.values <- getDialog("DiscretePlot", defaults)
    initializeDialog(title = gettextRcmdr("Plot Discrete Numeric Variable"), use.tabs=TRUE)
    xBox <- variableListBox(dataTab, DiscreteNumeric(), title = gettextRcmdr("Variable (pick one)"),
                            initialSelection = varPosn (dialog.values$initial.x, "numeric"))
    initial.group <- dialog.values$initial.group
    .groups <- if (is.null(initial.group)) FALSE else initial.group
    onOK <- function() {
        tab <- if (as.character(tkselect(notebook)) == dataTab$ID) 0 else 1
        x <- getSelection(xBox)
        nvalues <- eval(parse(text=paste0("length(unique(", ActiveDataSet(), "$", x, "))")))
        closeDialog()
        if (nvalues > 25){
            response <- RcmdrTkmessageBox(message=sprintf(gettextRcmdr("%s has %d unique values\nDo you want to proceed?"), x, nvalues),
                                          icon="question", type="okcancel", default="cancel")
            if ("cancel" == tclvalue(response)) {
                return()
            }
        }
        if (length(x) == 0) {
            errorCondition(recall = DiscretePlot, message = gettextRcmdr("You must select a variable"))
            return()
        }
        scale <- tclvalue(scaleVariable)
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if (xlab == gettextRcmdr("<auto>"))
            ""
        else paste(", xlab=\"", xlab, "\"", sep = "")
        ylab <- trim.blanks(tclvalue(ylabVar))
        ylab <- if (ylab == gettextRcmdr("<auto>"))
            ""
        else paste(", ylab=\"", ylab, "\"", sep = "")
        main <- trim.blanks(tclvalue(mainVar))
        main <- if (main == gettextRcmdr("<auto>"))
            ""
        else paste(", main=\"", main, "\"", sep = "")
        putDialog ("DiscretePlot", list (initial.x = x, initial.scale = scale,
                                         initial.tab=tab, initial.xlab=tclvalue(xlabVar), initial.ylab = tclvalue(ylabVar),
                                         initial.main = tclvalue(mainVar), initial.group=if (.groups == FALSE) NULL else .groups))
        if (is.null(.groups) || .groups == FALSE) {
            command <- paste("with(", ActiveDataSet(), ", discretePlot(", x, ', scale="', scale, '"',
                             xlab, ylab, main, "))", sep="")
        }
        else{
            command <- paste("with(", ActiveDataSet(), ", discretePlot(", x, ", by=", .groups, ', scale="',
                             scale, '"', xlab, ylab, main, "))", sep="")
        }
        doItAndPrint(command)
        insertRmdSection(paste0(gettextRmdHeader("Discrete Distribution Plot: "), x))
        activateMenus()
        tkfocus(CommanderWindow())
    }
    groupsBox(DiscretePlot, initialGroup=initial.group,
              initialLabel=if (is.null(initial.group)) gettextRcmdr("Plot by groups")
              else paste(gettextRcmdr("Plot by:"), initial.group), window=dataTab)
    OKCancelHelp(helpSubject = "discretePlot", reset = "DiscretePlot", apply="DiscretePlot")
    optionsFrame <- tkframe(optionsTab)
    optFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Options"),
                                                                font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    parFrame <- ttklabelframe(optionsFrame, labelwidget=tklabel(optionsFrame, text = gettextRcmdr("Plot Labels"),
                                                                font="RcmdrTitleFont", foreground=getRcmdr("title.color")))
    xlabVar <- tclVar(dialog.values$initial.xlab)
    ylabVar <- tclVar(dialog.values$initial.ylab)
    mainVar <- tclVar(dialog.values$initial.main)
    xlabEntry <- ttkentry(parFrame, width = "25", textvariable = xlabVar)
    xlabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand = function(...) tkset(xlabScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("x-axis label")), xlabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), xlabScroll, sticky = "ew", padx=6)
    ylabEntry <- ttkentry(parFrame, width = "25", textvariable = ylabVar)
    ylabScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand = function(...) tkset(ylabScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("y-axis label")), ylabEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text =""), ylabScroll, sticky = "ew", padx=6)
    mainEntry <- ttkentry(parFrame, width = "25", textvariable = mainVar)
    mainScroll <- ttkscrollbar(parFrame, orient = "horizontal",
                               command = function(...) tkxview(mainEntry, ...))
    tkconfigure(mainEntry, xscrollcommand = function(...) tkset(mainScroll,
                                                                ...))
    tkgrid(labelRcmdr(parFrame, text = gettextRcmdr("Graph title")), mainEntry, sticky = "ew", padx=6)
    tkgrid(labelRcmdr(parFrame, text=""), mainScroll, sticky = "ew", padx=6)
    axisFrame <- tkframe(optFrame)
    radioButtons(axisFrame, name = "scale", buttons = c("frequency", "percent"), 
                 labels = gettextRcmdr(c("Frequency counts", "Percentages")), title = gettextRcmdr("Axis Scaling"),
                 initialValue = dialog.values$initial.scale)
    tkgrid(getFrame(xBox), sticky = "nw")
    tkgrid(groupsFrame, sticky = "w")
    tkgrid(scaleFrame, sticky = "w")
    tkgrid(axisFrame, sticky = "w")
    
    tkgrid(optFrame, parFrame, sticky = "nswe", padx=6, pady=6)
    tkgrid(optionsFrame, sticky = "w")
    dialogSuffix(use.tabs=TRUE, grid.buttons=TRUE)
}

Symbox <- function () {
  defaults <- list(initial.variable = NULL, initial.family="bcPower", initial.start="", 
                   initial.powers="-1, -0.5, 0, 0.5, 1")
  dialog.values <- getDialog("Symbox", defaults)
  initializeDialog(title = gettextRcmdr("Symmetry Boxplot"), use.tabs=TRUE)
  variableBox <- variableListBox(top, Numeric(), title = gettextRcmdr("Variable (pick one)"),
                                 selectmode = "single", initialSelection = varPosn (dialog.values$initial.variable, "numeric"))
  radioButtons(top, name = "family", 
               buttons = c("bcPower", "bcnPower", "yjPower"), 
               labels = gettextRcmdr(c("Box-Cox", "Box-Cox with negatives", "Yeo-Johnson")),
               title = gettextRcmdr("Transformation Family"),
               initialValue = dialog.values$initial.family)
  startFrame <- tkframe(top)
  startVariable <- tclVar(dialog.values$initial.start)
  startField <- ttkentry(startFrame, width = "6", 
                         textvariable = startVariable)
  powersFrame <- tkframe(top)
  powersVariable <- tclVar(dialog.values$initial.powers)
  powersField <- ttkentry(powersFrame, width = "20", 
                          textvariable = powersVariable)
  onOK <- function() {
    variable <- getSelection(variableBox)
    family <- tclvalue(familyVariable)
    start <- trimws(tclvalue(startVariable))
    powers <- tclvalue(powersVariable)
    closeDialog()
    putDialog("Symbox", list(initial.variable=variable, initial.family=family, 
                             initial.start=start, initial.powers=powers))
    powers <- paste0("c(", gsub(",+", ",", gsub(" ", ",", powers)), ")")
    .activeDataSet <- ActiveDataSet()
    if (length(variable) < 1){
      errorCondition(recall = Symbox, message = gettextRcmdr("You must select a variable."))
      return()
    }
    command <- if (start == ""){
      paste0("symbox(~ ", variable, ", data=", .activeDataSet, ', trans=', family, 
             ", powers=", powers, ')')
    } else {
      paste0("symbox(~ ", variable, ", data=", .activeDataSet, ', trans=', family, 
             ", powers=", powers, ', start=', start, ')')
    }
    doItAndPrint(command)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject = "symbox", reset = "Symbox", apply="Symbox")
  tkgrid(getFrame(variableBox), sticky = "nw")
  tkgrid(tklabel(top, text=""), sticky="w")
  tkgrid(familyFrame, sticky = "w")
  tkgrid(tklabel(top, text=""), sticky="w")
  tkgrid(tklabel(startFrame, text=paste0(gettextRcmdr("Start (optional)"), " "), 
                 fg=getRcmdr("title.color")), startField, sticky="w")
  tkgrid(startFrame, sticky="w")
  tkgrid(tklabel(top, text=""), sticky="w")
  tkgrid(tklabel(powersFrame, text=paste0(gettextRcmdr("Powers"), " "), fg=getRcmdr("title.color")),
         powersField, sticky="w")
  tkgrid(powersFrame, stick="w")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix()
}
