########################################################
## Copyright (c) 2005
## University of Washington
## Licensed under the terms set forth by University of
## Washington. If you did not sign such a license, you
## are using this software/code illegally and you do not
## have permission to use, modify, or redistribute
## this or any files in this software package.
#########################################################
Rversion <- R.Version()
if(Rversion$major < "2" || as.numeric(substring(Rversion$minor, 0, 1)) < 4)
{
  stop("R version greater than or equal to 2.4.0 required")
}

gstrings <- list(load="Load/Save Expression Data and Covariates")

#########################################################################
#       Description:                                                    #
#       The EDGE package is a suite of functions designed to            #
#       facilitate differential expression for microarray data in       #
#       a cross-platform compatible, user friendly environment.         #
#       The package uses Tcl/Tk, R, and C++ to achieve this level       #
#       of functionality and platform independence.                     #
#       Languages:                                                      #
#       R, FORTRAN, Tcl/Tk                                              #
#       Author(s):                                                      #
#       Jeffrey Leek, John Storey and Alan Dabney                       #
#       Updated:                                                        #
#       June 2004                                                       #
#       References:                                                     #
#       See specific functions for references.                          #
#                                                                       #
#       COPYRIGHT 2004-2005 JEFFREY LEEK, ALAN DABNEY, AND JOHN STOREY  #
#         ALL RIGHTS RESERVED                                           #
#                                                                       #
#########################################################################

# Load the packages; first try locally
source("qvalue.r")
source("knnImpute.r")
source("cluster.r")

#########################################################################
# Load includes
#########################################################################
edge.source <- function(file, ...)
{
  print(paste("sourcing ", file, sep=""))
  source(file, ...)
}

edge.source("includeui.r")
edge.source("clusterui.r")
edge.source("odpui.r")

#########################################################################
#       This function opens the "Help" window.                          #
#       Author(s): Jeffrey Leek                                         #
#       Language: R                                                     #
#       References: None                                                #
#########################################################################
help.func <- function() {

  if (.Platform$OS.type == "windows") {
    openPDF("C:/Program Files/R/EDGE/help/edgehelp.pdf")
  } else {
    openPDF("help/edgehelp.pdf")
  }

}

about.func <- function() {
  result <- tkmessageBox(message = paste("EDGE version", edge.library.version()),
    icon = "info", type = "ok")
}

openPDF <- function (file, bg = TRUE) 
{
    #taken from Biobase package
    #Author: Robert Gentleman
    OST <- .Platform$OS.type
    if (OST == "windows") {
        shell.exec(file)
    }
    else if (OST == "unix") {
        pdf <- getOption("pdfviewer")
        if (is.null(pdf)) {
            warning(paste("pdfViewer is set to:", pdf, "which does not seem to exist.  Please", 
                "run the command setOptionPdfViewer()"))
            return(FALSE)
        }
        cmd <- paste(pdf, file)
        if (bg) 
            cmd <- paste(cmd, "&")
        system(cmd)
    }
    return(TRUE)
}


#########################################################################
#       This is the main EDGE UI function                               #
#       Arguments:                                                      #
#         exitOnClose - whether to exit R completely when the           #
#           application window is closed                                #
#         debug - whether or not debugging output is turned on          #
#       Environment variables:                                          #
#         EDGE_DATA - path to file containing expression data           #
#         EDGE_DATA_NACHAR - string representing NA values in data file #
#         EDGE_DATA_HASDESC - "TRUE" or "FALSE" indicating whether      #
#           data file has a Description column                          #
#         EDGE_COV - path to file containing covariate data             #
#########################################################################
appClosing <- FALSE
edge <- function (exitOnClose = TRUE, debug = FALSE) {

  require(tcltk, quietly = TRUE, keep.source = FALSE)  || stop("TCLTK support is absent.")
  require(tools, quietly = TRUE, keep.source = FALSE) || stop("Package tools support is absent.")
  require(stats, quietly = TRUE, keep.source = FALSE) || stop("Package stats support is absent.")
  
  debugOn <<- debug
  dataDir <- getwd()

# to make debugging easier, initialize the random number
# seed to a known value when debugging.
  if(debug) set.seed(123456,kind=NULL)
 
  error.handler <- function(err) {
    post.txt.msg(message.txt, paste("\nError:", err$message))
  }

#########################################################################
  ##   This function checks that the covariate data is loaded, and prints  #
  ##     an error message to the message window if it is not.              #
  #########################################################################
  get.covariate.data <- function()
  {
    edgePData <- tryCatch(get("edgePData", edgeEnv), error=function(e){})
    if (is.null(edgePData))
    {
      post.txt.msg(message.txt, paste("Covariate data is not loaded. Please select '",
                                      gstrings$load,"', and load covariate data.", sep=""))
      return(NULL)
    }
    edgePData
  }
  
  get.var.labels <- function()
  {
    edgeVarLabels <- tryCatch(get("edgeVarLabels", edgeEnv), error=function(e){})
    if (is.null(edgeVarLabels))
    {
      post.txt.msg(message.txt, paste("Input data is not loaded. Please select '",
                                      gstrings$load,"', and load input and covariate data.", sep=""))
      return(NULL)
    }
    edgeVarLabels
  }
  
  get.gene.names <- function()
  {
    edgeGeneNames <- tryCatch(get("edgeGeneNames", edgeEnv), error=function(e){})
    if (is.null(edgeGeneNames))
    {
      post.txt.msg(message.txt, paste("Input data is not loaded. Please select '",
                                      gstrings$load,"', and load input and covariate data.", sep=""))
      return(NULL)
    }
    edgeGeneNames
  }

  get.expression.data <- function()
  {
    edgeExprs <- tryCatch(get("edgeExprs", edgeEnv), error=function(e){})
    
    if (is.null(edgeExprs))
    {
      post.txt.msg(message.txt, paste("Input data is not loaded. Please select '",
                                      gstrings$load,"', and load input and covariate data.", sep=""))
      return(NULL)
    }
  
    edgeExprs
  }

  get.expression.data.transformed <- function()
  {
    err <- NULL
    isTransformed <- tryCatch(get("edgeExprsTransformed", edgeEnv), error=function(e) err <<- e)

    if(!is.null(err))
      return(FALSE)

    if(!is.logical(isTransformed))
      stop("isTransformed is not a logical value")
    
    isTransformed
  }
  
  set.expression.data.transformed <- function(isTransformed=TRUE)
  {
    assign("edgeExprsTransformed", isTransformed, pos = edgeEnv)
  }

#########################################################################
    ##       Load the apropriate packages and define variables for           #
  ##       use in the EDGE functions.                                      #
  #########################################################################


  ## Set fonts to be used for the GUI
  if (.Platform$OS.type == "unix") {
    title.font = "Helvetica 18"
    normal.font = "Helvetica 14"
    little.font = "Helvetica 11"
    table.font = "CourierNew 12"
  } else {
    title.font = "Helvetica 14"
    normal.font = "Helvetica 11"
    little.font = "Helvetica 11"
    table.font = "CourierNew 12"
  }

  ## Set colors to be used in GUI
  uidefaults <<- new.uidefaults(
    titleFont = title.font,
    background="black",
    bigForeground="#33CCFF",
    normalFont=normal.font,
    buttonBackground="#33CCFF",
    buttonForeground="black",
    foreground="white",
    listForeground="black",
    listBackground="white",
    littleFont=little.font,
    tableFont=table.font
  )
				   
  ## Initialize Variables
  edge.base <<- NULL
  edge.match <<- NULL 
  fc <<- NULL 
  out <- NULL
  exprfile.var <- tclVar("") 
  covfile.var <- tclVar("")
if(!exists("edgeEnv"))
#  gah - changed from: edgeEnv <<- new.env(FALSE, NULL) 
  edgeEnv <<- new.env(FALSE)

  nbplots.var <- tclVar("Number of Boxplots per Screen (max)")
  exprna.var <-  tclVar("NA")
  expr.cbval <- tclVar("0")
  imputeprogress.var <- tclVar("")
  tnullperm.var <- tclVar("100")
  foldlevel.var <- tclVar("2")
  from2.var = tclVar("0.0")
  to2.var = tclVar("0.1")
  adjustcov.cbval <- tclVar("0")
  completeperm.cbval <- tclVar("0")
  logconst.var <- tclVar("0")
  plotnum <<- 0 
  foldc  <<- NULL
  diffextype <<- "static"
  window.width <<- "2.5i"
  window.width2 <<- "7i"
  window.height <<- "9i"

  #########################################################################
  ##     This function runs the menu selected by the user.                 #
  #########################################################################

  go.func <- function() {
    usrchoice <- as.numeric(tkcurselection(options.list)) + 1
    
    if(usrchoice == usrchoice.load) 
      load.func()
    else if(usrchoice == usrchoice.impute)
      impute.func()
    else if(usrchoice == usrchoice.viewcov)
      viewcov.func()
    else if(usrchoice == usrchoice.norm)
      norm.func()
    else if(usrchoice == usrchoice.boxplot)
      boxplot.func()
    else if(usrchoice == usrchoice.pca)
      pca.func()
    else if(usrchoice == usrchoice.diffex)
      diffex.func()
    else if(usrchoice == usrchoice.clusterall)
      clusterall.func()
  }


  diffex.func <- function(...) {
    tryCatch(diffex.func.int(...), error=error.handler)
  }
  
  diffex.func.int <- function() {
    diffexdone.func <- function() {
      current.error <- getOption("error")
      
      diffexresultsdone.func <- function() { 
        om <- tclServiceMode(TRUE)
        tkpack.forget(diffexresults.frm)
        tkdestroy(diffexresults.frm)
        tkpack.forget(message.frm)
        tkdestroy(message.frm)
        tkpack(edge.frm, side="left")
        tkpack(diffex.frm)
        tclServiceMode(om)
      }

      #Create the error message box
      message.frm <- tkframe(edge.base, relief = "raised", bd = 2)
      message.txt <- tktext(message.frm, bg =uidefaults$background,fg=uidefaults$foreground,
                            font = uidefaults$normalFont, height = 10, width = 60, wrap="word")
      message.scr <- tkscrollbar(message.frm, command = function(...) tkyview(message.txt, ...))
      tkconfigure(message.txt, yscrollcommand = function(...) tkset(message.scr, ...))
      tkpack(message.txt, side = "left", fill = "both", expand = TRUE)
      tkpack(message.scr, side = "right", fill = "y")
  
      ## Create diffexresults frame
      diffexresults.frm <- getdiffexresultsframe.func(
        edge.base, 
        get("edgeExprs", edgeEnv),
        get("edgeGeneNames", edgeEnv),
        printmsg=function(...) post.txt.msg(message.txt, ...))
      tkbind(diffexresults.frm, "<<Done>>", diffexresultsdone.func)

      tkbind(diffexresults.frm, "<Destroy>",
             function() { if(!appClosing) options(error=current.error) })
    
      ## Pack it
      tkpack.forget(diffex.frm)
      tkpack.forget(edge.frm, side="left")
      options(error=function(...) post.txt.msg(message.txt, paste("Error: ", geterrmessage()), ...))
      tkpack(diffexresults.frm)
      tkpack(message.frm)
  
    }
  
    diffexsettingsdone.func <- function() { 
      options(error=error.option.handler)
      tkconfigure(options.list, state = "normal")
      tkconfigure(go.but, state = "normal")
      tkpack.forget(diffex.frm) 
    }
  
  
    edgeExprs <- get.expression.data()
    if(is.null(edgeExprs))
      return(0)

    if(ncol(edgeExprs)<2) {
      tkmessageBox(message = paste("Cannot identify differentially expressed genes,",
                     "because the expression dataset has fewer than 2 arrays."),
                   icon = "error", type = "ok")
      return(0)
    }

    edgeVarLabels <- get.var.labels()
    if(is.null(edgeVarLabels))
      return(0)
    edgePData <- get.covariate.data()
    if(is.null(edgePData))
      return(0)
    
    diffex.frm <- getdiffexsettingsframe.func(edge.base, edgeExprs, edgePData, edgeVarLabels, 
  			                uidefaults,
                                        printmsg=function(...) post.txt.msg(message.txt, ...) )
    tkbind(diffex.frm, "<<DiffexDone>>", diffexdone.func)
    tkbind(diffex.frm, "<<SettingsDone>>", diffexsettingsdone.func)
    tkconfigure(options.list, state = "disabled")
    tkconfigure(go.but, state = "disabled")
    om <- tclServiceMode(TRUE)
    tkpack(diffex.frm)  
    tclServiceMode(om)
  }

  #########################################################################
  ##      These are the functions that appear in the "Options" Menu. All   #
  #########################################################################

  ######################################################################### 
  ##      This function opens the "Load" window.                           #
  ##      Author(s): Jeffrey Leek                                          #
  ##      Language: R                                                      #
  ##      References: None                                                 #
  ######################################################################### 

  ## Functions called: findexpr.func, readexpr.ui.func, findcov.func, readcov.ui.func

  load.func <- function(...) {
    tryCatch(load.func.int(...), error=error.handler)
  }

  load.func.int <- function() { 
    ## Create the image saving function
    saveimage.func <- function(){
      imagefile <- tclvalue(tkgetSaveFile(initialfile="edge.RData",filetypes="{{R Image Files} {.RData}}"))
      edgeExprs <<- get("edgeExprs", pos = edgeEnv)
      edgeGeneNames <<- get("edgeGeneNames", pos = edgeEnv)
      edgeAnnotate <<- get("edgeAnnotate", pos = edgeEnv)
      edgePData <<- get("edgePData", pos = edgeEnv)
      edgeVarLabels <<- get("edgeVarLabels", pos = edgeEnv)
      save.image(file=imagefile)
    }
    
    ## Create the "Load" Window Frame
    tkconfigure(options.list, state = "disabled")
    tkconfigure(go.but, state = "disabled")
    load.frm <- tkframe(edge.base, bd = 2, bg = uidefaults$background, relief = "raised",width=window.width,height=window.height)

    ## Create the load expression frame. 
    expr.frm <- tkframe(load.frm, bd = 2, bg = uidefaults$background)
    exprinset.frm <- tkframe(expr.frm, relief = "groove", bd = 2, bg = uidefaults$background)
    exprfile.frm <- tkframe(exprinset.frm, bg = uidefaults$background)
    exprfile.lbl <- tklabel(exprfile.frm, text = "File name:", font = uidefaults$normalFont, bg = uidefaults$background, fg = uidefaults$foreground)
    exprfile.ety <- tkentry(exprfile.frm, textvariable = exprfile.var, font = uidefaults$normalFont, width = 50,
      bg = uidefaults$listBackground, fg = uidefaults$listForeground)
    exprna.frm <- tkframe(exprinset.frm, bg = uidefaults$background)
    exprna.lbl <- tklabel(exprna.frm, text = "Missing data character string:", font = uidefaults$normalFont, bg = uidefaults$background, fg = uidefaults$foreground)
    exprna.ety <- tkentry(exprna.frm, textvariable = exprna.var, font = uidefaults$normalFont, bg = uidefaults$listBackground, fg = uidefaults$listForeground, 
      width = 20)
    
    ## Create the description checkbutton
    exprdc.frm <- tkframe(exprinset.frm)
    expr.cb <- new.checkbutton(exprdc.frm, uidefaults=uidefaults, variable = expr.cbval)

    ## Create the "Browse" and "Load" buttons for the covariates
    ebuttons.frm <- tkframe(exprinset.frm)
    ebrowse.but <- tkbutton(ebuttons.frm, text = "Browse", font = uidefaults$normalFont, bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground, 
      command = findexpr.func)
    eload.but <- tkbutton(ebuttons.frm, text = "Load", font = uidefaults$normalFont, bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground, 
      command = loadexpr.btn.func)

    ## Create the load covariate frame.
    cov.frm <- tkframe(load.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    covinset.frm <- tkframe(cov.frm, relief = "groove", bd = 2, bg = uidefaults$background)
    covfile.frm <- tkframe(covinset.frm, bg = uidefaults$background)
    covfile.lbl <- tklabel(covfile.frm, text = "File name:", font = uidefaults$normalFont, bg = uidefaults$background, fg = uidefaults$foreground)
    covfile.ety <- tkentry(covfile.frm, textvariable = covfile.var, font = uidefaults$normalFont, width = 50, bg = uidefaults$listBackground, 
      fg = uidefaults$listForeground)

    ## Create the "Browse" and "Load" buttons for the covariates
    cbuttons.frm <- tkframe(covinset.frm)
    cbrowse.but <- tkbutton(cbuttons.frm, text = "Browse", font = uidefaults$normalFont, command = findcov.func, 
      bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)
    cload.but <- tkbutton(cbuttons.frm, text = "Load", font = uidefaults$normalFont, command = loadcov.btn.func, bg = uidefaults$buttonBackground,
      fg = uidefaults$buttonForeground)

    ## Create the "Done" button that closes the "Load" Window
    loadbuts.frm <- tkframe(load.frm,relief="raised",bd=2,bg=uidefaults$background)
    loaddone.but <- tkbutton(loadbuts.frm, text = "DONE", command = function() { tkpack.forget(load.frm); 
      tkconfigure(options.list, state = "normal"); tkconfigure(go.but, state = "normal") }, bg = uidefaults$buttonBackground, 
      fg = uidefaults$buttonForeground, font = uidefaults$titleFont)
    saveimage.but <- tkbutton(loadbuts.frm,text="SAVE", command=saveimage.func,bg=uidefaults$buttonBackground,fg=uidefaults$buttonForeground,font=uidefaults$titleFont)
    tkgrid(loaddone.but,saveimage.but)

    ## Pack all of the appropriate frames onto the "Load" Window
    tkpack(tklabel(expr.frm, text = "Read Expression Data:", font = uidefaults$titleFont, bg = uidefaults$background, fg = uidefaults$bigForeground), anchor = "w")
    tkpack(exprfile.lbl, side = "left")
    tkpack(exprfile.ety, side = "right", fill = "x", expand = TRUE)
    tkpack(exprfile.frm, fill = "x", expand = TRUE)
    tkpack(exprna.lbl, side = "left")
    tkpack(exprna.ety, side = "left")
    tkpack(exprna.frm, fill = "x", expand = TRUE)
    tkpack(expr.frm)
    tkpack(exprinset.frm)
    tkpack(tklabel(exprdc.frm,
                   text = "Check if there is a Description column",
                   font = uidefaults$normalFont,
                   bg = uidefaults$background, 
                   fg = uidefaults$foreground),
           side = "left")
    tkpack(expr.cb$frame, side = "right")
    tkpack(exprdc.frm)
    tkgrid(ebrowse.but, eload.but)
    tkpack(tklabel(cov.frm, text = "Read Covariate Data:",
                   font = uidefaults$titleFont,
                   bg = uidefaults$background,
                   fg = uidefaults$bigForeground),
           anchor = "w")
    tkpack(ebuttons.frm)
    tkpack(covfile.lbl, side = "left")
    tkpack(covfile.ety, side = "right", fill = "x", expand = TRUE)
    tkpack(covfile.frm, fill = "x", expand = TRUE)
    tkpack(covinset.frm)
    tkpack(cov.frm)
    tkgrid(cbrowse.but, cload.but)
    tkpack(cbuttons.frm)
    tkpack(loadbuts.frm)
    om <- tclServiceMode(TRUE)
    tkpack(load.frm)
    tclServiceMode(om)
    .Tcl("update idletasks")
  }

  ######################################################################### 
  ##     This function opens the "Impute" window.                          #
  ##     Author(s): Jeffrey Leek                                           #
  ##     Language: R                                                       #
  ##     References: CITE                                                  #
  ######################################################################### 
  impute.func <- function(...) {
    tryCatch(impute.func.int(...), error=error.handler)
  }
  
  impute.func.int <- function() {
    ## Get the number of complete genes.
    edgeExprs <- get.expression.data()
    if(is.null(edgeExprs))
      return(0)
    edgeGeneNames <- get.gene.names()
    if(is.null(edgeGeneNames))
      return(0)

    ngene = dim(edgeExprs)[1]
    narray = dim(edgeExprs)[2]
    ncgene <- sum(!is.na(edgeExprs %*% rep(1, narray)))
    ncarray <- sum(!is.na(t(edgeExprs) %*% rep(1, ngene)))
    nctotal <- sum(!is.na(edgeExprs))
    
    ## Display the percent of genes and arrays missing values.
    displaymissingdata.func <- function() {
      percentgene <- round(100 - 100 * ncgene / ngene, 2)
      percentarray <-round(100 - 100 * ncarray / narray, 2)
      percenttotal <- round(100 - 100 * nctotal / (ngene * narray), 2)
      tclvalue(missinggenes.var) <- paste("Percent of genes missing data: ", as.character(percentgene), "%\n")
      tclvalue(missingarrays.var) <-  paste("Percent of arrays missing data: ", as.character(percentarray), "%\n")
      tclvalue(totalmissing.var) <- paste("Overall percent of missing data: ", as.character(percenttotal), "%\n")
    }

    ## This function removes rows with excess missing values and
    ## calls knnimpute.
    imputedata.func <- function() {
      k <- as.integer(tclvalue(k.var))
      tol <- as.double(tclvalue(tolerance.var))
      if(k > ncgene) {
        post.txt.msg(message.txt,
          "The number of nearest neighbors must be less than the number of complete genes.",
           bell=TRUE)
      } else {
        tol.row <- (drop(is.na(edgeExprs) %*% rep(1 / narray, narray)) > tol / 100) * (1:ngene)
        if(sum(tol.row) != 0) {
          assign("edgeExprs.NA", edgeExprs, pos = edgeEnv)
          edgeExprs <- edgeExprs[-tol.row, ]
          post.txt.msg(message.txt, "The data set with missing values has been assigned to edgeExprs.NA.",bell=TRUE)
          post.txt.msg(message.txt, paste(sum(tol.row != 0), "genes with more than", round(tol), "% missing values have been eliminated from edgeExprs."),bell=FALSE)

          coln <- colnames(edgeExprs)
          genen <- edgeGeneNames[-tol.row]
          ngene <- dim(edgeExprs)[1]
          narray <- dim(edgeExprs)[2]
        } else {
          post.txt.msg(message.txt, "No genes were removed from the data set.",bell=FALSE)
          coln <- colnames(edgeExprs)
          genen <- edgeGeneNames
        }

        edgeExprs <- do.impute.knn(edgeExprs, k = k, rowmax = 1, colmax = 1, maxp = 1500)
        colnames(edgeExprs) <- coln
        edgeGeneNames <- genen
        ngene <<- dim(edgeExprs)[1]
        narray <<- dim(edgeExprs)[2]
        ncgene <<- sum(!is.na(edgeExprs %*% rep(1, narray)))
        ncarray <<- sum(!is.na(t(edgeExprs) %*% rep(1, ngene)))
        nctotal <<- sum(!is.na(edgeExprs))
        assign("edgeExprs", edgeExprs, pos = edgeEnv)
        assign("edgeGeneNames", edgeGeneNames, pos = edgeEnv)

        post.txt.msg(message.txt, "Imputation complete.",bell=TRUE)
      }
    }

    ## Create the "Impute" Window.
    tkconfigure(options.list, state = "disabled")
    tkconfigure(go.but, state = "disabled")
    impute.frm <- tkframe(edge.base, bd = 2, bg = uidefaults$background,width=window.width,height=window.height)

    ## Create the missing data frame.
    missingdata.frm <- tkframe(impute.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    missingdatainsert.frm <- tkframe(missingdata.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    missinggenes.frm <- tkframe(missingdatainsert.frm, bg = uidefaults$background)
    missinggenes.var <- tclVar("Percent of genes missing data:\n")
    missinggenes.lbl <- tklabel(missinggenes.frm, text = tclvalue(missinggenes.var), font = uidefaults$normalFont,
      bg = uidefaults$background, fg = uidefaults$foreground)
    tkconfigure(missinggenes.lbl, textvariable = missinggenes.var)
    missingarrays.frm <- tkframe(missingdatainsert.frm, bg = uidefaults$background)
    missingarrays.var <- tclVar("Percent of arrays missing data:\n")
    missingarrays.lbl <- tklabel(missingarrays.frm, text = tclvalue(missingarrays.var), font = uidefaults$normalFont,
      bg = uidefaults$background, fg = uidefaults$foreground)
    tkconfigure(missingarrays.lbl, textvariable = missingarrays.var)
    totalmissing.frm <- tkframe(missingdatainsert.frm, bg = uidefaults$background)
    totalmissing.var <- tclVar("Overall percent of missing data:\n")
    totalmissing.lbl <- tklabel(totalmissing.frm, text = tclvalue(totalmissing.var), font = uidefaults$normalFont,
      bg = uidefaults$background, fg = uidefaults$foreground)
    computemissing.but <- tkbutton(missingdata.frm, text = "CALCULATE MISSING DATA STATISTICS",
      font = uidefaults$normalFont, command = displaymissingdata.func, bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)
    tkconfigure(totalmissing.lbl, textvariable = totalmissing.var)

    ## Create the input frame for tolerance and number of nearest neighbors.
    iinput.frm <- tkframe(impute.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    tkpack(tklabel(iinput.frm, text = "KNN Parameters", font = uidefaults$titleFont, bg = uidefaults$background, fg = uidefaults$bigForeground), anchor = "w")
    iinputinsert.frm <- tkframe(iinput.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    tolerance.frm <- tkframe(iinputinsert.frm, bg = uidefaults$background)
    tolerance.var <-tclVar("20") 
    tolerance.lbl <- tklabel(tolerance.frm, text = "Percent of missing values to tolerate in a gene: ", 
      font = uidefaults$normalFont, bg = uidefaults$background, fg = uidefaults$foreground)
    tolerance.ety <- tkentry(tolerance.frm, textvariable = tolerance.var, font = uidefaults$normalFont, bg = uidefaults$listBackground,
      fg = uidefaults$listForeground)
    k.frm <- tkframe(iinputinsert.frm, bg = uidefaults$background)
    k.var <- tclVar("15")    
    k.lbl <- tklabel(k.frm,
                     text = paste("Number of nearest neighbors to use (maximum of", 15, ") :"),
                     font = uidefaults$normalFont,
                     bg = uidefaults$background,
                     fg = uidefaults$foreground)
    k.ety <- tkentry(k.frm,
                     textvariable = k.var,
                     font = uidefaults$normalFont,
                     bg = uidefaults$listBackground,
                     fg = uidefaults$listForeground)

    ## Create the imputation buttons frame. 
    imputebuttons.frm <- tkframe(impute.frm, bg = uidefaults$background)
    imputego.but <- tkbutton(imputebuttons.frm, text = "GO", font = uidefaults$titleFont, command = imputedata.func, 
      bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)
    imputedone.but <- tkbutton(imputebuttons.frm, text = "DONE", font = uidefaults$titleFont, 
      command = function() { tkpack.forget(impute.frm); tkconfigure(options.list, state = "normal"); 
      tkconfigure(go.but, state = "normal") }, bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)

    ## Create the Spacing Frames
    spaceimpute1.frm <- tkframe(missingdata.frm, bg = uidefaults$background, width = 30, height = 15)
    spaceimpute2.frm <- tkframe(impute.frm, bg = uidefaults$background, width = 30, height = 15)

    ## Pack all of the frames onto the "Impute" Window.
    om <- tclServiceMode(TRUE)
    tkpack(tklabel(missingdata.frm, text = "Percent Missing Data", font = uidefaults$titleFont, bg = uidefaults$background, fg = uidefaults$bigForeground),
      anchor = "w")
    tkpack(missinggenes.lbl, side = "left")
    tkpack(missinggenes.frm)
    tkpack(missingarrays.lbl, side = "left")
    tkpack(missingarrays.frm)
    tkpack(totalmissing.lbl, side = "left")
    tkpack(totalmissing.frm)
    tkpack(missingdatainsert.frm, fill = "x")
    tkpack(spaceimpute1.frm)
    tkpack(computemissing.but)
    tkpack(missingdata.frm)
    tkpack(spaceimpute2.frm)
    tkpack(tolerance.lbl, side = "left")
    tkpack(tolerance.ety, side = "right")
    tkpack(tolerance.frm, fill = "x", expand = TRUE)
    tkpack(k.lbl, side = "left")
    tkpack(k.ety, side = "right")
    tkpack(k.frm, fill = "x", expand = TRUE)
    tkpack(iinputinsert.frm)
    tkgrid(imputego.but, imputedone.but)
    tkpack(iinputinsert.frm)
    tkpack(iinput.frm)
    tkpack(imputebuttons.frm)
    tkpack(impute.frm)
    tclServiceMode(om)
  }
    
  #########################################################################
  ##       This function opens the "View Covariates" window.               #
  ##       Author(s): Jeffrey Leek                                         #
  ##       Language: R                                                     #
  ##       References: None                                                #
  #########################################################################
  viewcov.func <- function(...) {
    tryCatch(viewcov.func.int(...), error=error.handler)
  }

  viewcov.func.int <- function() {
    edgePData <- get.covariate.data()
    if(is.null(edgePData))
      return(0)
    
    ## Create the View Covariates window
    tkconfigure(options.list, state = "disabled")
    tkconfigure(go.but, state = "disabled")
    viewcov.frm <- tkframe(edge.base, bg = uidefaults$background, bd = 2, width = window.width, height = window.height)
    
    scr <- tkscrollbar(viewcov.frm, repeatinterval = 8, command = function(...) tkyview(txt, ...))
    txt <- tktext(viewcov.frm, bg = uidefaults$listBackground, fg = uidefaults$listForeground,
                  font = uidefaults$normalFont, 
                  yscrollcommand = function(...) tkset(scr, ...),
                  height = 8, width=60, wrap="word")
    tkgrid(txt, scr)
    tkgrid.configure(scr, sticky = "ns")
    if(exists("edgeExprs", edgeEnv) && (dim(edgePData)[1] >= 1)){
      for(i in (1:dim(edgePData)[1])) {
        tkinsert(txt, "end", paste(rownames(edgePData)[i], "\n"))
        tkinsert(txt, "end", paste(edgePData[i,]))
        tkinsert(txt, "end", "\n")
      }
    }
    else{tkinsert(txt,"end","Load Covariate Information First")}

    covdone.but <- tkbutton(viewcov.frm, text = "DONE", command = function() { tkpack.forget(viewcov.frm); 
      tkconfigure(options.list, state = "normal"); tkconfigure(go.but, state = "normal") }, bg = uidefaults$buttonBackground, 
      fg = uidefaults$buttonForeground, font = uidefaults$titleFont)
    tkgrid(covdone.but)
    tkfocus(txt)
    tkpack(viewcov.frm)
    .Tcl("update idletasks")
  }

  ######################################################################### 
  ##       This function opens the "Transform, Centering and Scaling"      #
  ##       window.                                                         #
  ##       Author(s): Jeffrey Leek                                         #
  ##       Language: R                                                     #
  ##       References: None                                                #
  #########################################################################

  ## Internal functions:  normgo.func

  norm.func <- function(...) {
    tryCatch(norm.func.int(...), error=error.handler)
  }
  
  norm.func.int <- function() {
    edgeExprs <- get.expression.data()
    if(is.null(edgeExprs))
      return(0)
    
    ## Create the "Centering and Scaling" Window
    tkconfigure(options.list, state = "disabled")
    tkconfigure(go.but, state = "disabled")
    norm.frm <- tkframe(edge.base, relief = "raised", bd = 2, bg = uidefaults$background,width=window.width,height=window.height)

    ## Create the centering list box.
    centering.frm <- tkframe(norm.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    centeringinset.frm <- tkframe(centering.frm, bd = 2, bg = uidefaults$background, relief = "raised")
    centering.list <- tklistbox(centeringinset.frm, height = 3, selectmode = "single", bg = uidefaults$listBackground, fg = uidefaults$listForeground,
      exportselection = "false", width = 25)
    tkinsert(centering.list, "end", "Mean Centering")
    tkinsert(centering.list, "end", "Median Centering")
    tkinsert(centering.list, "end", "No Centering") 
    tkselection.set(centering.list, 2)

    ## Create the log base 2 transform list box.
    logtransform.frm <- tkframe(norm.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    logtransforminset.frm <- tkframe(logtransform.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    logtransform.list <- tklistbox(logtransforminset.frm, height = 2, selectmode = "single", bg = uidefaults$listBackground,
      fg = uidefaults$listForeground, exportselection = "false", width = 25)
    tkinsert(logtransform.list, "end", "Log 2 Transform")
    tkinsert(logtransform.list, "end", "None")
    tkselection.set(logtransform.list, 1)
    logtransform.lbl <- tklabel(logtransform.frm, text = "Add a constant before taking the log:", font = uidefaults$titleFont,
      bg = uidefaults$background, fg = uidefaults$bigForeground)
    logtransform.ety <- tkentry(logtransform.frm, textvariable = logconst.var, font = uidefaults$normalFont, bg = uidefaults$listBackground,
      fg = uidefaults$listForeground)

    ## Create the scaling list box.
    scaling.frm <- tkframe(norm.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    scalinginset.frm <- tkframe(scaling.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    scaling.list <- tklistbox(scalinginset.frm, height = 3, selectmode = "single", bg = uidefaults$listBackground, fg = uidefaults$listForeground,
      exportselection = "false", width = 25)
    tkinsert(scaling.list, "end", "Standard Deviation Scaling")
    tkinsert(scaling.list, "end", "Absolute Deviation Scaling")
    tkinsert(scaling.list, "end", "No Scaling") 
    tkselection.set(scaling.list, 2)

    normgo.func <- function() {
      t <- as.numeric(tkcurselection(logtransform.list))
      c <- as.numeric(tkcurselection(centering.list))
      s <- as.numeric(tkcurselection(scaling.list))
      edgeExprs = get.expression.data() 
      if(is.null(edgeExprs))
        return(0)

      if(get.expression.data.transformed())
        {
          result <- tkmessageBox(message = "The data has already been transformed. Transform again?",
                                 icon = "warning", type = "yesno", default = "no")
          if(tclvalue(result) == "no")
            {
              post.txt.msg(message.txt, "Data was NOT transformed.")
              return(0)
            }
        }
      
      edgeExprs <- normalize(edgeExprs, t, c, s)
      set.expression.data.transformed(TRUE)
      assign("edgeExprs", edgeExprs, edgeEnv)
      post.txt.msg(message.txt, "Data transformed successfully.")
###      om <- tclServiceMode(TRUE)
###      tkpack.forget(norm.frm)
###      tkconfigure(options.list, state = "normal")
###      tkconfigure(go.but, state = "normal")
###      tclServiceMode(om)
    }

    ## Create the buttons frame for the normalization window.
    normbuttons.frm <- tkframe(norm.frm, bg = uidefaults$background)
    normgo.but <- tkbutton(normbuttons.frm, text = "GO",
                           font = uidefaults$titleFont,
                           command=normgo.func, 
                           bg = uidefaults$buttonBackground,
                           fg = uidefaults$buttonForeground)
    normcancel.but <- tkbutton(normbuttons.frm, text = "DONE",
                               font = uidefaults$titleFont,
                               bg = uidefaults$buttonBackground,
                               fg = uidefaults$buttonForeground,
                               command = function() {
                                 tkpack.forget(norm.frm);
                                 tkconfigure(options.list, state = "normal"); 
                                 tkconfigure(go.but, state = "normal") })
    tkgrid(normgo.but, normcancel.but)

    ## Create the spacing frames
    spacenorm1.frm <- tkframe(norm.frm, bg = uidefaults$background, width = 30, height = 10)
    spacenorm2.frm <- tkframe(norm.frm, bg = uidefaults$background, width = 30, height = 10)
    spacenorm3.frm <- tkframe(norm.frm, bg = uidefaults$background, width = 30, height = 10)

    ## Pack the frames onto the GUI.
    tkpack(tklabel(logtransform.frm, text = "Log Transform:", font = uidefaults$titleFont, bg = uidefaults$background, fg = uidefaults$bigForeground),
      anchor = "w")
    tkpack(logtransform.list)
    tkpack(logtransforminset.frm, fill = "x")
    tkpack(logtransform.lbl, side = "left")
    tkpack(logtransform.ety, side = "left")
    tkpack(logtransform.frm, fill = "x")
    tkpack(spacenorm2.frm)
    tkpack(tklabel(centering.frm, text = "Centering Method:", font = uidefaults$titleFont, bg = uidefaults$background,
      fg = uidefaults$bigForeground), anchor = "w")
    tkpack(centering.list)
    tkpack(centeringinset.frm, fill = "x")
    tkpack(centering.frm, fill = "x")
    tkpack(spacenorm1.frm)
    tkpack(tklabel(scaling.frm, text = "Scaling Method:", font = uidefaults$titleFont, bg = uidefaults$background, fg = uidefaults$bigForeground),
      anchor = "w")
    tkpack(scaling.list)
    tkpack(scalinginset.frm, fill = "x")
    tkpack(scaling.frm, fill = "x")
    tkpack(spacenorm3.frm)
    tkpack(normbuttons.frm, fill = "x")
    om <- tclServiceMode(TRUE)
    tkpack(norm.frm)
    tclServiceMode(om)
    .Tcl("update idletasks")
  }

  ######################################################################### 
  ##       This function opens the "Boxplot" window.                       #
  ##       Author(s): Jeffrey Leek                                         #
  ##       Language: R                                                     #
  ##       References: None                                                #
  #########################################################################

  ## Internal functions: nbplots.func, covplot.func, nextcov.func

  boxplot.func <- function(...) {
    tryCatch(boxplot.func.int(...), error=error.handler)
  }

  boxplot.func.int <- function() { 
    edgeExprs <- get.expression.data()
    if(is.null(edgeExprs))
      return(0)
    edgeVarLabels <- get.var.labels()
    if(is.null(edgeVarLabels))
      return(0)
    edgePData <- get.covariate.data()
    if(is.null(edgePData))
      return(0)

    ## A function to display the number of possible boxplots
    nbplots.func <- function() {
      boxplot.val <- as.numeric(tkcurselection(bp.list))
      cov.vector <- as.factor(as.character(edgePData[boxplot.val, ]))
      xx1 <- min(dim(edgeExprs)[2], 4)
      xx2 <- min(nlevels(cov.vector), 4)
      if(as.numeric(tkcurselection(bp.list)) == 0){
        tclvalue(nbplots.var) <- paste("Number of Boxplots per Screen (max", xx1, ")")
        tclvalue(nplots.var) <- xx1
      }
      else {
        boxplot.val <- as.numeric(tkcurselection(bp.list))
        tclvalue(nbplots.var) <- paste("Number of Boxplots per Screen (max", xx2, ")")
        tclvalue(nplots.var) <- xx2
      }
    }

    ## Create the "Boxplot" Window
    tkconfigure(options.list, state = "disabled")
    tkconfigure(go.but, state = "disabled")
    boxplot.frm <- tkframe(edge.base, bd = 2, bg = uidefaults$background,width=window.width,height=window.height)
    covchoice.frm <- tkframe(boxplot.frm, relief = "raised", bd = 2, bg = uidefaults$background)

    ## Create the Covariate Choice list.
    ccinset.frm <- tkframe(covchoice.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    boxscr <- tkscrollbar(ccinset.frm, repeatinterval = 5, command = function(...) tkyview(bp.list, ...))
    bp.list<- tklistbox(ccinset.frm, height = 5, selectmode = "single", 
      yscrollcommand = function(...) tkset(boxscr, ...), bg = uidefaults$listBackground, fg = uidefaults$listForeground, 
      exportselection = "false")
    tkgrid(bp.list, boxscr)
    tkgrid.configure(boxscr, rowspan = 5, sticky = "nsw")

    l <- length(edgeVarLabels)
    if(l > 0) {
      tkinsert(bp.list, "end", "Data Array Order")
      for(i in 1:l)
        tkinsert(bp.list, "end", as.character(edgeVarLabels[i]))

      tkselection.set(bp.list, 0)
    } else {
      tkinsert(bp.list, "end", "Data Array Order")
      tkselection.set(bp.list, 0)
    }
    plotnum <<- 0

    tkbind(bp.list, "<ButtonRelease-1>", nbplots.func)

    ## This function displays the first n boxplots.
    covplot.func <- function() {
      nplots <- as.numeric(tclvalue(nplots.var))
      boxplot.val <- as.numeric(tkcurselection(bp.list))
      cov.vector <- as.factor(as.character(edgePData[boxplot.val, ]))
      xx1 <- min(dim(edgeExprs)[2], 8)
      xx2 <- min(nlevels(cov.vector), 8)

      if((nplots > xx1) && (boxplot.val == 0))
        post.txt.msg(message.txt, paste("The number of plots must be less than or equal to", xx1),bell=TRUE)
      if((boxplot.val > 0)  && (nplots > xx2))
        post.txt.msg(message.txt, paste("The number of plots must be less than or equal to", xx2),bell=TRUE)
      else {
        xx <- bplot.func(nplots, boxplot.val, cov.vector)
        if(xx == "go") {
          tkconfigure(boxplotok.but, state = "disabled")
          tkconfigure(bp.list, state = "disabled")
          tkconfigure(boxplotnext.but, state = "normal")
        } else {
          tkconfigure(boxplotok.but, state = "normal")
          tkconfigure(bp.list, state = "normal")
          tkconfigure(boxplotnext.but, state = "disabled")
        }
      }
    }

    ## This function displays the next n boxplots
    nextcov.func <- function() {
      nplots <- as.numeric(tclvalue(nplots.var))
      boxplot.val <- as.numeric(tkcurselection(bp.list))
      cov.vector <- as.factor(as.character(edgePData[boxplot.val, ]))
      xx <- nextbplot.func(nplots, boxplot.val, cov.vector)

      if(xx == "end"){
        tkconfigure(boxplotok.but, state = "normal")
        tkconfigure(bp.list, state = "normal")
        tkconfigure(boxplotnext.but, state = "disabled")
      }
    }

    nplots.var <- tclVar("1")

    ## This entry box allows the user to enter the number of boxplots per Screen.
    nplots.frm <- tkframe(boxplot.frm, bg = uidefaults$background)
    nplots.lbl <- tklabel(nplots.frm, text = tclvalue(nbplots.var), font = uidefaults$normalFont, bg = uidefaults$background, 
      fg = uidefaults$foreground)
    tkconfigure(nplots.lbl, textvariable = nbplots.var)
    nplots.ety <- tkentry(nplots.frm, textvariable = nplots.var, font = uidefaults$normalFont, bg = uidefaults$listBackground, 
      fg = uidefaults$listForeground)
    xx1 <- min(dim(edgeExprs)[2], 4)
    tclvalue(nbplots.var) <- paste("Number of Boxplots per Screen (max", xx1,")")

    
    ## This creates the Boxplot buttons frame. 
    boxplotbuttons.frm <- tkframe(boxplot.frm, bg = uidefaults$background)
    boxplotok.but<- tkbutton(boxplotbuttons.frm, text = "OK", font = uidefaults$titleFont, command = covplot.func,
      bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)
    boxplotnext.but <- tkbutton(boxplotbuttons.frm, text = "NEXT BOXPLOT", font = uidefaults$titleFont, 
      command = nextcov.func, bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)
    boxplotcancel.but <- tkbutton(boxplotbuttons.frm, text = "DONE", font = uidefaults$titleFont,
      command = function() { tkpack.forget(boxplot.frm); tkconfigure(go.but, state = "normal"); 
      tkconfigure(options.list, state = "normal"); plotnum <<- 0; if(dev.cur() > 1) { dev.off() } },
      bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)
    tkgrid(boxplotok.but, boxplotnext.but, boxplotcancel.but)

    ## Pack the frames onto the "Boxplot" Window
    tkpack(tklabel(covchoice.frm, text = "Boxplots by Covariate", font = uidefaults$titleFont, bg = uidefaults$background,
      fg = uidefaults$bigForeground), anchor = "w")
    tkpack(covchoice.frm, fill = "x")
    tkpack(ccinset.frm, fill = "x")
    tkpack(nplots.lbl, side = "left")
    tkpack(nplots.ety, side = "right", expand = TRUE)
    tkpack(nplots.frm, fill = "x", expand = TRUE)
    tkpack(boxplot.frm)
    tkpack(boxplotbuttons.frm, fill = "x")
    om <- tclServiceMode(TRUE)
    tkpack(boxplot.frm, fill = "x")
    tclServiceMode(om)
    .Tcl("update idletasks")
  }

  ######################################################################### 
  ##       This function opens the "Principal Component Analysis" window.  #
  ##       Author(s): Jeffrey Leek                                         #
  ##       Language: R                                                     #
  ##       References: None                                                #
  #########################################################################

  ## Internal functions: pcaactive.func, pcaplot.func, pcanext.func

  pca.func <- function(...) {
    tryCatch(pca.func.int(...), error=error.handler)
  }

  pca.func.int <- function() {
    edgeExprs <- get.expression.data()
    if(is.null(edgeExprs))
      return(0)
    edgeVarLabels <- get.var.labels()
    if(is.null(edgeVarLabels))
      return(0)
    edgePData <- get.covariate.data()
    if(is.null(edgePData))
      return(0)

    ## Create the "Princple Component Analysis" Window
    pca.frm <- tkframe(edge.base, relief = "raised", bd = 2, bg = uidefaults$background,width=window.width,height=window.height)
    tkconfigure(options.list, state = "disabled")
    tkconfigure(go.but, state = "disabled")

    pcaactive.func <- function() {
      if(as.numeric(tkcurselection(plotchoice.list)) == 0)
        tkconfigure(pca.list, state = "normal")
      else
        tkconfigure(pca.list, state = "disabled")
    }

    ## Functions for plotting
    pcaplot.func <- function() {
    dat <- edgeExprs #get("edgeExprs", edgeEnv)
#    edgePData <- get("edgePData", edgeEnv)

#      dat <- edgeExprs

      nplots <- as.integer(tclvalue(neigen.var))
      pcaplot.val <- as.numeric(tkcurselection(pca.list))
      cov.vector <- as.factor(as.character(edgePData[pcaplot.val, ]))
      eigen <- "arrays"
      if(as.numeric(tkcurselection(plotchoice.list)) == 0)
        eigen <- "genes"

      if(is.na(sum(dat)) == T)
        post.txt.msg(message.txt, "There are missing values in your data, please use imputation!",bell=TRUE)
      else {
        xx1 <- min(dim(edgeExprs)[2], 8)
        xx2 <- xx1
        if((nplots > xx1) && (as.numeric(tkcurselection(plotchoice.list)) == 0))
          post.txt.msg(message.txt, paste("The number of plots must be less than or equal to", xx1),bell=TRUE)
        if((as.numeric(tkcurselection(plotchoice.list)) > 0)  && (nplots > xx2))
          post.txt.msg(message.txt, paste("The number of plots must be less than or equal to", xx2),bell=TRUE)
        else {
          xx <- pplot.func(nplots, eigen, pcaplot.val, cov.vector)
          if(xx == "go") {
            tkconfigure(eigenok.but, state = "disabled")
            tkconfigure(pca.list, state = "disabled")
            tkconfigure(plotchoice.list, state = "disabled")
            tkconfigure(eigennext.but, state = "normal")
            tkconfigure(neigen.ety, state = "disabled")
          } else {
            tkconfigure(eigenok.but, state = "normal")
            tkconfigure(pca.list, state = "normal")
            tkconfigure(plotchoice.list, state = "normal")
            tkconfigure(eigennext.but, state = "disabled")
            tkconfigure(neigen.ety, state = "normal")
          }
        }
      }
    }

    pcanext.func <- function() {
#      edgePData <- get("edgePData", edgeEnv)
      nplots <- as.numeric(tclvalue(neigen.var))
      pcaplot.val <- as.numeric(tkcurselection(pca.list))
      cov.vector <- as.factor(as.character(edgePData[pcaplot.val, ]))
      eigen <- "arrays"
      if(as.numeric(tkcurselection(plotchoice.list)) == 0)
        eigen <- "genes"
      xx <- nextpplot.func(nplots, eigen, pcaplot.val, cov.vector)
      if(xx == "end"){
        tkconfigure(eigenok.but, state = "normal")
        tkconfigure(pca.list, state = "normal")
        tkconfigure(plotchoice.list, state = "normal")
        tkconfigure(eigennext.but, state = "disabled")
        tkconfigure(neigen.ety, state = "normal")
      }
    }

#    edgeExprs <- get("edgeExprs", edgeEnv)
#    edgeVarLabels <- get("edgeVarLabels", edgeEnv)

    ## Get the singular value decomposition.
    if(sum(dim(edgeExprs)) != 0)
      l <- length(edgeVarLabels)
    else
      l <- 0

    ## Create the listbox of covariates to plot eigengenes by. 
    covchoice.frm <- tkframe(pca.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    ccinset.frm <- tkframe(covchoice.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    pcascr <- tkscrollbar(ccinset.frm, repeatinterval = 5, command = function(...) tkyview(pca.list, ...))
    pca.list<- tklistbox(ccinset.frm, height = 5, selectmode = "single", 
      yscrollcommand = function(...) tkset(pcascr, ...), bg = uidefaults$listBackground, fg = uidefaults$listForeground, 
      exportselection = "false")
    if(l >= 1) {
      tkinsert(pca.list, "end", "Data Array Order")
      for(i in 1:l)
        tkinsert(pca.list, "end", as.character(edgeVarLabels[i]))
    } else
      tkinsert(pca.list, "end", "Data Array Order")
    tkselection.set(pca.list, 0)
    tkgrid(pca.list, pcascr)
    tkgrid(pca.list)
    tkgrid.configure(pcascr, rowspan = 5, sticky = "nsw")

    ## Boxes to determine the number of eigengenes and eigenarrays to plot.
    neigen.var <- tclVar("2")                       
    numberofeigen.frm <- tkframe(pca.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    neigen.ety <- tkentry(numberofeigen.frm, textvariable = neigen.var, font = uidefaults$normalFont,
      bg = uidefaults$listBackground, fg = uidefaults$listForeground)

    ## Create the button to select which to plot. 
    plotchoice.frm <- tkframe(pca.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    pcinset.frm <- tkframe(plotchoice.frm, relief = "raised", bd = 2, bg = uidefaults$background)
    plotchoice.list <- tklistbox(pcinset.frm, height = 2, selectmode = "single", bg = uidefaults$listBackground,
      fg = uidefaults$listForeground, exportselection = "false")
    tkinsert(plotchoice.list, "end", "Eigengenes")
    tkinsert(plotchoice.list, "end", "Eigenarrays")
    tkselection.set(plotchoice.list, 0)
    tkgrid(plotchoice.list)

    tkbind(plotchoice.list, "<ButtonRelease-1>", pcaactive.func)

    ## Create the "Princple Component Analysis" buttons frame. 
    pcabuttons.frm <- tkframe(pca.frm, bg = uidefaults$background)
    eigenok.but<- tkbutton(pcabuttons.frm, text = "OK", font = uidefaults$titleFont, command = pcaplot.func,
      bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)
    eigennext.but <- tkbutton(pcabuttons.frm, text = "Next", font = uidefaults$titleFont, command = pcanext.func,
      bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)
    pcadone.but <- tkbutton(pcabuttons.frm, text = "DONE", font = uidefaults$titleFont, 
      command = function() { tkpack.forget(pca.frm); plotnum <<-0; tkconfigure(options.list, state = "normal");
      tkconfigure(go.but, state = "normal"); if(dev.cur() > 1) { dev.off() } }, bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground)
    tkgrid(eigenok.but, eigennext.but, pcadone.but)

    ## Create the spacing windows. 
    spacepca1.frm <- tkframe(pca.frm, bg = uidefaults$background, width = 30, height = 15)
    spacepca2.frm <- tkframe(pca.frm, bg = uidefaults$background, width = 30, height = 15)
    spacepca3.frm <- tkframe(pca.frm, bg = uidefaults$background, width = 30, height = 15)

    ## Get the singular value decomposition.
    if(sum(dim(edgeExprs)) != 0){
      wait.frm <- tkframe(edge.base, bg = uidefaults$background, relief = "raised", bd = 2)
      wait.lbl <- tklabel(wait.frm, text = "One moment please, principal components are being calculated",
        font = uidefaults$titleFont, bg = uidefaults$background, fg = uidefaults$bigForeground)
      post.txt.msg(message.txt, "One moment please, principal components are being calculated",bell=FALSE)
      tkpack(wait.frm)
      tkpack(wait.lbl)

      ngene <- dim(edgeExprs)[1]
      data <- t(scale(t(scale(edgeExprs,scale=FALSE)),scale=FALSE))
      v <<- svd(data)
      u <<- v$u
      d <<- v$d
      d2 <<- sum(v$d^2)
      v <<- v$v
      l <- length(edgeVarLabels)

      tkpack.forget(wait.frm)
      tkconfigure(plotchoice.list, state = "normal")
      tkconfigure(pca.list, state = "normal")
      tkconfigure(neigen.ety, state = "normal")
      tkconfigure(eigenok.but, state = "normal")
      tkconfigure(eigennext.but, state = "disabled")
    } else {
      tkconfigure(plotchoice.list, state = "disabled")
      tkconfigure(pca.list, state = "disabled")
      tkconfigure(neigen.ety, state = "disabled")
      tkconfigure(eigenok.but, state = "disabled")
      tkconfigure(eigennext.but, state = "disabled")

      l <- 0
    }

    ## Pack the frames onto the GUI
    om <- tclServiceMode(TRUE)
    tkpack(tklabel(plotchoice.frm, text = "Plot:", font = uidefaults$titleFont, bg = uidefaults$background, fg = uidefaults$bigForeground),
      anchor = "w")
    tkpack(pcinset.frm)
    tkpack(plotchoice.frm)
    tkpack(spacepca1.frm)
    tkpack(tklabel(covchoice.frm, text = "Plot by Variable:", font = uidefaults$titleFont, bg = uidefaults$background, fg = uidefaults$bigForeground),
      anchor = "w")
    tkpack(ccinset.frm)
    tkpack(covchoice.frm, fill = "x")
    tkpack(spacepca2.frm)
    tkpack(tklabel(numberofeigen.frm, text = "Number to Plot (max of 8): ", font = uidefaults$normalFont, bg = uidefaults$background,
      fg = uidefaults$bigForeground), side = "left")
    tkpack(numberofeigen.frm, fill = "x")
    tkpack(neigen.ety, side = "left")
    tkpack(spacepca3.frm)
    tkpack(pcabuttons.frm, fill = "x")
    tkpack(pca.frm, fill = "x")
    tclServiceMode(om)
    .Tcl("update idletasks")
  }

  clustsave.func <- function() {
    ## get clustering
    if(!exists("edgeClust", edgeEnv) )
      {
        post.txt.msg(message.txt, "Error: No clustering data available")
	return("error_no_data")
      }

    edgeExprs <- get.expression.data()
    if(is.null(edgeExprs))
      return(0)
    
    hc <- get("edgeClust", edgeEnv)
    if(is.null(hc))
      {
        post.txt.msg(message.txt, "Error: No clustering data available")
	return("error_no_data")
      }

    edgeGeneNames=NA
    if(exists("edgeGeneNames", edgeEnv))
      edgeGeneNames <- get("edgeGeneNames", edgeEnv)
    
    ## prompt for a filename
    pdffile <- tclvalue(tkgetSaveFile(initialfile="cluster.pdf",filetypes="{{PDF} {.pdf}}"))
    if(pdffile != "")
      {
        ## save the plot
	pdf(pdffile)
	post.txt.msg(message.txt, "Saving plot...")
	plstoreyclust.func(edgeExprs, hc, rowLabels=edgeGeneNames)
	dev.off()
	post.txt.msg(message.txt, "Plot saved.")
      }
    else
      {
        post.txt.msg(message.txt, "File not saved.")
      }
  }
  
  
  ######################################################################### 
  ##     This function opens the "Cluster" window.                         #
  ##     Author(s): Eva Monsen                                             #
  ##     Language: R                                                       #
  ##     References:                                                       #
  ######################################################################### 
  clusterall.func <- function() {

    edgeExprs <- get.expression.data()
    if(is.null(edgeExprs))
      return(0)
    
    edgeGeneNames <- get("edgeGeneNames", edgeEnv)

    getclusteroptionswindow.func(edge.base, edgeExprs, uidefaults,
      rowNames=edgeGeneNames, colNames=colnames(edgeExprs))

  }

  #########################################################################
  ##       Utility functions.                                              #
  #########################################################################


  #########################################################################
  ##       These functions find and load expression data from a file.      #
  #########################################################################

  ## Called from: load.func

  findexpr.func <- function() { 
    path <- tclvalue(tkgetOpenFile(initialdir=dataDir))
    tclvalue(exprfile.var) <- path
    ## Save directory
    if(!is.null(path))
      dataDir <<- dirname(path)

  }

  loadexpr.btn.func <- function(...) {
    tryCatch(loadexpr.btn.func.int(...), error=error.handler)
  }
  
  loadexpr.btn.func.int <- function() {
    expr.file <- tclvalue(exprfile.var)
    na.char <- as.character(tclvalue(exprna.var))
    has.desc <- as.logical(as.integer(tclvalue(expr.cbval)))
    readexpr.ui.func(expr.file, na.char, has.desc)
  }
  
  readexpr.ui.func <- function(expr.file, na.char, has.desc) {
    if(expr.file == "")
      post.txt.msg(message.txt, "ERROR: No file selected.", bell=TRUE)
    else {
      post.txt.msg(message.txt, "Reading expression data...", bell=FALSE)
      edge.data <- readexpr.func(expr.file, na.char, has.desc)
      assign("edgeExprs", edge.data$exprs, edgeEnv)
      assign("edgeAnnotate", edge.data$annotate, edgeEnv)
      assign("edgeGeneNames", edge.data$geneNames, edgeEnv)
      assign("edgePData", NULL, edgeEnv)
      assign("edgeVarLabels", NULL, edgeEnv)

      post.txt.msg(message.txt, paste("Read",as.character(nrow(edge.data$exprs)), "genes,", as.character(ncol(edge.data$exprs)), "arrays."),bell=TRUE)
      post.txt.msg(message.txt, "Assigned data to variables 'edgeExprs', 'edgeAnnotate', and 'edgeGeneNames'.",bell=FALSE)
      }
    }

  #########################################################################
  ##      These functions find and load the covariate information.         #
  #########################################################################
  findcov.func <- function() {
    path <- tclvalue(tkgetOpenFile(initialdir=dataDir))
    tclvalue(covfile.var) <- path
    ## Save directory
    if(!is.null(path))
      dataDir <<- dirname(path)
  }

  loadcov.btn.func <- function(...) {
    tryCatch(loadcov.btn.func.int(...), error=error.handler)
  }
  
  loadcov.btn.func.int <- function() {
    edgeExprs <- get.expression.data()
    if(is.null(edgeExprs))
      return(0)

    cov.file <- tclvalue(covfile.var)
    readcov.ui.func(cov.file, edgeExprs)
  }
  
  readcov.ui.func <- function(cov.file, edgeExprs) {
    if(cov.file == "")
      post.txt.msg(message.txt, "ERROR: No file selected.",bell=TRUE)
    else {
      post.txt.msg(message.txt, "Reading covariate data...")

      cov.class <- readcov.func(cov.file)
      
      edgePData <- cov.class$covData
      nr <- dim(edgePData)[1]
      nc <- dim(edgePData)[2]
        
      if(dim(edgeExprs)[2] != nc) {
        post.txt.msg(message.txt, "The dimensions of your covariates do not match the dimensions of the data!",bell=TRUE)
        post.txt.msg(message.txt, "Covariate data has not been loaded.",bell=FALSE)
      } else {
        edgeVarLabels <- cov.class$varLabels
        assign("edgePData", edgePData, edgeEnv)
        assign("edgeVarLabels", edgeVarLabels, edgeEnv)

        ## Show progress
        if(nr <= 3) {
          covtxt <- ""
          for(i in 1:nr)
            covtxt <- paste(covtxt, rownames(edgePData)[i])
          post.txt.msg(message.txt, paste("Read covariates:", covtxt, "."),bell=TRUE)
          post.txt.msg(message.txt, "Created 'edgePData' object.",bell=FALSE)
        } else {
          post.txt.msg(message.txt, paste("Read covariates:",
                                          as.character(rownames(cov.class$covData)[1]),
                                          as.character(rownames(cov.class$covData)[2]), 
                                          "...", as.character(rownames(cov.class$covData)[nr])),
                       bell=TRUE)
          post.txt.msg(message.txt, "Created 'edgePData' object.",bell=FALSE)
        }
      }
    }
  }

  edgedone.func <- function() {
    result <- tkmessageBox(message = "Closing the EDGE menu will remove all results, do you wish to quit?", 
      icon = "warning", type = "yesno", default = "yes")
    if(tclvalue(result) == "yes") {
        rm(list = ls())
        tkdestroy(edge.base)
        q(save="no")
    }
    last.warning <<- NULL
  }


  #########################################################################
  ##       These two functions display the appropriate boxplots.           #
  ##       Author(s): Jeffrey Leek                                         #
  ##       Language: R                                                     #
  ##       References:                                                     #
  ##       Arguments:                                                      #
  ##         nplots - The number of plots per screen.                      #
  ##         boxplot.val - The covariate indicator.                        #
  ##         cov.vector - The vector of covariate information.             #
  #########################################################################
  bplot.func <- function(nplots, boxplot.val, cov.vector) {
    edgeExprs <- get("edgeExprs", edgeEnv)
    edgeVarLabels <- get("edgeVarLabels", edgeEnv)
    mnmx <- c(min(edgeExprs),max(edgeExprs))

    if(boxplot.val > 0) {
      l <- nlevels(cov.vector)
      cov.levels <- levels(cov.vector)
      plotnum <<- 1

      par(mfrow = c(1, nplots))
      for(i in 1:nplots) {
        boxplot(edgeExprs[, cov.vector == cov.levels[i]],ylim=mnmx)
        title(main = paste(edgeVarLabels[boxplot.val], cov.levels[i]))
      }

      par(mfrow = c(1, 1))
      if((plotnum * nplots) >= l) 
        return("end")
      else
        return("go")
    } else {
      plotnum <<- 1
      l <- dim(edgeExprs)[2]

      par(mfrow = c(1, nplots))
      for(i in 1:nplots) {
        boxplot(edgeExprs[, i],ylim=mnmx)
        title(main = paste("Array", i))
      }

      par(mfrow = c(1, 1))
      if((plotnum * nplots) >= l)
        return("end")
      else
        return("go")
    }
  }

  nextbplot.func <- function(nplots, boxplot.val, cov.vector) {
    edgeExprs <- get("edgeExprs", edgeEnv)
    edgeVarLabels <- get("edgeVarLabels", edgeEnv)
    mnmx <- c(min(edgeExprs),max(edgeExprs))
    if(boxplot.val > 0) {
      l <- nlevels(cov.vector)
      cov.levels <- levels(cov.vector)
      if(((plotnum + 1) * nplots) >= l) {
        par(mfrow = c(1, (l - plotnum * nplots)))
        for(i in (plotnum * nplots + 1):l) {
          boxplot(edgeExprs[, cov.vector == cov.levels[i]],ylim=mnmx)
          title(main = paste(edgeVarLabels[boxplot.val], cov.levels[i]))
        }

        plotnum <<- plotnum + 1
        return("end")
      } else {
        par(mfrow = c(1, nplots))
        for(i in (plotnum * nplots + 1):((plotnum + 1) * nplots)) {
          boxplot(edgeExprs[, cov.vector == cov.levels[i]],ylim=mnmx)
          title(main = paste(edgeVarLabels[boxplot.val], cov.levels[i]))
        }

        plotnum <<- plotnum + 1
        return("go")
      }
    } else {
      l <- dim(edgeExprs)[2]
      if(((plotnum + 1) * nplots) >= l) {
        par(mfrow = c(1, (l - plotnum * nplots)))
        for(i in (plotnum * nplots + 1):l) {
          boxplot(edgeExprs[, i],ylim=mnmx)
          title(main = paste(edgeVarLabels[boxplot.val], "Array", i))
        }

        plotnum <<- plotnum + 1
        return("end")
      } else {
        par(mfrow = c(1, nplots))
        for(i in (plotnum * nplots + 1):((plotnum + 1) * nplots)) {
          boxplot(edgeExprs[, i],ylim=mnmx)
          title(main = paste(edgeVarLabels[boxplot.val], "Array", i))
        }

        plotnum <<- plotnum + 1
        return("go")
      }
    }
  }

  pplot.func <- function(nplots, eigen, pcaplot.val, cov.vector) {
    edgeExprs <- get("edgeExprs", edgeEnv)
    edgeVarLabels <- get("edgeVarLabels", edgeEnv)

    if(eigen == "arrays") {
      plotnum <<- 1
      l <- dim(edgeExprs)[2]

      par(mfrow = c(1, nplots))
      for(i in 1:nplots) {
        plot(u[, i], type = "l", col = "black", xlab = "Gene", ylab = "Eigen Array")
        title(main = paste(edgeVarLabels[pcaplot.val], paste("Eigen Array", i)))
      }

      par(mfrow = c(1, 1))
      if((plotnum * nplots) >= l)
        return("end")
      else
        return("go")
    } else {
      if(pcaplot.val > 0) {
        l <- dim(edgeExprs)[2]
        cov.levels <- levels(cov.vector)
        plotnum <<- 1

        par(mfrow = c(1, nplots))
        for(i in 1:nplots) {
          var1 <- "Eigengene Value"
          var2 <- edgeVarLabels[pcaplot.val]
          var3 <- round(d[i] ^ 2 / d2 * 100) 

          plot(make.consecutive.int(cov.vector), v[, i], xaxt = "n", ylab = var1, xlab = var2, 
            main = paste("Eigengene", i, ": ", var3, "% of Variation"), col = "black")
          axis(side = 1, at = make.consecutive.int(cov.vector), labels = cov.vector)
        }

        par(mfrow = c(1, 1))
        if((plotnum * nplots) >= l)
          return("end")
        else
          return("go")
      } else {
        plotnum <<- 1
        l <- dim(edgeExprs)[2]

        par(mfrow = c(1, nplots))
        for(i in 1:nplots) {
          var1 <- "Eigengene Value"
          var2 <- "Array"
          var3 <- round(d[i] ^ 2 / d2 * 100) 

          plot(1:length(v[, i]), v[, i], ylab = var1, xlab = var2, 
            main = paste("Eigengene", i, ": ", var3, "% of Variation"), col = "black")
        }

        par(mfrow = c(1, 1))
        if((plotnum * nplots) >= l)
          return("end")
        else
          return("go")
      }
    }
  }

  nextpplot.func <- function(nplots, eigen, pcaplot.val, cov.vector) {
    edgeExprs = get("edgeExprs", edgeEnv)
    edgeVarLabels = get("edgeVarLabels", edgeEnv)
    if(eigen == "arrays") {
      l <- dim(edgeExprs)[2]
      if(((plotnum + 1) * nplots) >= l) {
        par(mfrow=c(1, (l - plotnum * nplots)))

        for(i in (plotnum * nplots + 1):l) {
          plot(u[, i], type = "l", col = "black", xlab = "Gene", ylab = "Eigen Array")
          title(main = paste(edgeVarLabels[pcaplot.val], paste("Eigen Array", i)))
        }

        plotnum <<- plotnum + 1
        return("end")
      } else {
        par(mfrow = c(1, nplots))

        for(i in (plotnum * nplots + 1):((plotnum + 1) * nplots)) {
          plot(u[, i],type = "l", col = "black", xlab = "Gene", ylab = "Eigen Array")
          title(main = paste(edgeVarLabels[pcaplot.val], paste("Eigen Array", i)))
        }

        plotnum <<- plotnum + 1
        return("go")
      }
    } else {
      if(pcaplot.val > 0) {
        l <- dim(edgeExprs)[2]
        cov.levels <- levels(cov.vector)
        if(((plotnum + 1) * nplots) >= l) {
          par(mfrow = c(1, (l - plotnum * nplots)))

          for(i in (plotnum * nplots + 1):l) {
            var1 <- "Eigengene Value"
            var2 <- edgeVarLabels[pcaplot.val]
            var3 <- round(d[i] ^ 2 / d2 * 100) 

            plot(make.consecutive.int(cov.vector), v[, i], xaxt = "n", ylab = var1, xlab = var2,
              main = paste("Eigengene", i, ": ", var3, "% of Variation"), col = "black")
            axis(side = 1, at = make.consecutive.int(cov.vector),labels = cov.vector)
          }

          par(mfrow=c(1, 1))
          plotnum <<- plotnum + 1
          return("end")
        } else {
          par(mfrow = c(1, nplots))

          for(i in (plotnum * nplots + 1):((plotnum + 1) * nplots)) {
            var1 <- "Eigengene Value"
            var2 <- edgeVarLabels[pcaplot.val]
            var3 <- round(d[i] ^ 2 / d2 * 100) 

            plot(make.consecutive.int(cov.vector), v[, i], xaxt = "n", ylab = var1, xlab = var2, 
              main = paste("Eigengene", i, ": ", var3, "% of Variation"), col = "black")
            axis(side = 1, at = make.consecutive.int(cov.vector),labels = cov.vector)
          }

          plotnum <<- plotnum + 1
          return("go")
        }
      } else {
        l <- dim(edgeExprs)[2]
        if(((plotnum + 1) * nplots) >= l) {
          par(mfrow = c(1, (l - plotnum * nplots)))

          for(i in (plotnum * nplots + 1):l) {
            var1 <- "Eigengene Value"
            var2 <- "Array"
            var3 <- round(d[i] ^ 2 / d2 * 100) 

            plot(1:length(v[, i]), v[, i], ylab = var1, xlab = var2, 
              main = paste("Eigengene", i, ": ", var3, "% of Variation"), col = "black")
          }

          par(mfrow = c(1, 1))
          plotnum <<- plotnum + 1
          return("end")
        } else {
          par(mfrow = c(1, nplots))

          for(i in (plotnum * nplots + 1):((plotnum + 1) * nplots)) {
            var1 <- "Eigengene Value"
            var2 <- "Array"
            var3 <- round(d[i] ^ 2 / d2 * 100) 

            plot(1:length(v[, i]), v[, i], ylab = var1, xlab = var2, 
              main = paste("Eigengene", i, ": ", var3, "% of Variation"), col = "black")
          }

          par(mfrow=c(1,1))
          plotnum <<- plotnum + 1
          return("go")
        }
      }
    }
  }

  #########################################################################
  ##       This function transforms the data.                              #
  ##       Author(s): Jeffrey Leek                                         #
  ##       Language: R                                                     #
  ##       References:                                                     #
  ##       Arguments:                                                      #
  ##         dat - The data matrix, an array with m genes and n arrays.    #
  ##         t - The log2 transform decision indicator.                    #
  ##         c - The centering decision indicator.                         #
  ##         s - The scaling decision indicator.                           #
  #########################################################################
  normalize <- function(dat, t, c, s) {
    if(t == 0) {
      if(sum((dat + as.numeric(tclvalue(logconst.var))) <= 0, na.rm = T) != 0) {
        post.txt.msg(message.txt, "Log 2 Transform Cannot Be Completed. There are 0",bell=TRUE)
        post.txt.msg(message.txt, "or negative expression values.",bell=FALSE)
      } else {
        dat <- log2(dat + as.numeric(tclvalue(logconst.var)))
        post.txt.msg(message.txt, "Log base 2 transform completed.",bell=FALSE)
      }
    }
    if(c == 0) {
      dat <- scale(dat, scale = FALSE)
      post.txt.msg(message.txt, "Mean centering completed.",bell=FALSE)
    }
    else if(c == 1) {
      dat <- scale(dat, scale = FALSE, center = apply(dat, 2, median))
      post.txt.msg(message.txt, "Median centering completed.",bell=FALSE)
    }
    if(s == 0) {
      dat <- scale(dat, center = FALSE, scale = apply(dat, 2, sd))
      post.txt.msg(message.txt, "Standard deviation scaling completed.",bell=FALSE)
    }
    else if(s == 1) {
      dat <- scale(dat, center = FALSE, scale = apply(dat, 2, mad))
      post.txt.msg(message.txt, "Median absolute deviation scaling completed.",bell=FALSE)
    }

    return(dat)
  }

  ## Bind to the Destroy window event so that we can exit R
  edge.destroy.func <- function()
  {
    appClosing <<- TRUE
    if(exitOnClose)
      q(save="no")
    else
    {
      print("Resetting error handling option to default."); options(error=NULL)
    }
  }

  #########################################################################
  ##   This code creates the basic EDGE interface.                         #
  #########################################################################
  edge.base <<- tktoplevel(bg = uidefaults$background,
                           relief="raised",bd=3)

  ## Create the "EDGE" window.
  tkwm.title(edge.base, "EDGE")
  top.menu <- tkmenu(edge.base, bg = uidefaults$background)
  tkconfigure(edge.base, menu = top.menu)
  edge.frm <- tkframe(edge.base, bg = uidefaults$background)
  tkbind(edge.frm, "<Destroy>", edge.destroy.func)
  
  ## Add the pull down menus to the "EDGE" window.
  file.menu <- tkmenu(top.menu, tearoff = F)
  help.menu <- tkmenu(top.menu, tearoff = F)
  tkadd(top.menu, "cascade", label = "File", menu = file.menu)
  tkadd(top.menu, "cascade", label = "Help", menu = help.menu)
  tkadd(file.menu, "command", label = "Quit", command = edgedone.func)
  tkadd(help.menu, "command", label = "Help", command = help.func)
  tkadd(help.menu, "command", label = "About", command = about.func)
  tkconfigure(top.menu, bg = uidefaults$background, fg = uidefaults$foreground)
  tkconfigure(file.menu, bg = uidefaults$background, fg = uidefaults$foreground)
  tkconfigure(help.menu, bg = uidefaults$background, fg = uidefaults$foreground)

  ## Add the "EDGE" logo.
# gah - change ckcmd to tcl
  tcl("image", "create", "photo", "edgelogo", file = "edge.gif")
  logo <- tklabel(edge.frm, image = "edgelogo", bg = uidefaults$background)
  ##logo <- new.png(edge.frm, imagefile="edge.png", uidefaults)

  ## Create the main menu for "EDGE"
  options.frm <- tkframe(edge.frm, bd = 2, bg = uidefaults$background)
# Change height to 8 when clustering is ready.
  options.list <- tklistbox(options.frm, height = 8, width = 60, selectmode = "single", bg = uidefaults$listBackground,
    fg = uidefaults$listForeground, exportselection = "false")
  tkgrid(tklabel(options.frm, text = "Select Your Option", font = uidefaults$titleFont, fg = uidefaults$bigForeground, bg = uidefaults$background), sticky = "w")
  tkinsert(options.list, "end", gstrings$load)
  usrchoice.load = as.numeric(tclvalue(tksize(options.list)))
  tkinsert(options.list, "end", "Impute Missing Data")
  usrchoice.impute = as.numeric(tclvalue(tksize(options.list)))
  tkinsert(options.list, "end", "View Covariates")
  usrchoice.viewcov = as.numeric(tclvalue(tksize(options.list)))
  tkinsert(options.list, "end", "Transform Data")
  usrchoice.norm = as.numeric(tclvalue(tksize(options.list)))
  tkinsert(options.list, "end", "Display Boxplots")
  usrchoice.boxplot = as.numeric(tclvalue(tksize(options.list)))
  tkinsert(options.list, "end", "Perform Hierarchical Clustering")
  usrchoice.clusterall = as.numeric(tclvalue(tksize(options.list)))
  tkinsert(options.list, "end", "Display Eigengenes and Eigenarrays")
  usrchoice.pca = as.numeric(tclvalue(tksize(options.list)))
  tkinsert(options.list, "end", "Identify Differentially Expressed Genes")
  usrchoice.diffex = as.numeric(tclvalue(tksize(options.list)))
  tkgrid(options.list)
  tkselection.set(options.list, 0)
  go.but <- tkbutton(options.frm, text = "GO", command = go.func, bg = uidefaults$buttonBackground, fg = uidefaults$buttonForeground, font = uidefaults$titleFont)
  tkgrid(go.but)
  
  #Create the error message box
  message.frm <- tkframe(edge.frm, relief = "raised", bd = 2)
  message.txt <- tktext(message.frm, bg =uidefaults$background,fg=uidefaults$foreground,
                        font = uidefaults$normalFont, height = 10, width = 60, wrap="word")

  error.option.handler <- function(...) {
    post.txt.msg(message.txt, paste("Error: ", geterrmessage()), ...)
  }
  print("Setting error option to EDGE-specific error.option.handler")
  options(error=error.option.handler)
  

  message.scr <- tkscrollbar(message.frm, command = function(...) tkyview(message.txt, ...))
  tkconfigure(message.txt, yscrollcommand = function(...) tkset(message.scr, ...))
  tkpack(message.txt, side = "left", fill = "both", expand = TRUE)
  tkpack(message.scr, side = "right", fill = "y")


  ## Pack all of the windows onto the "EDGE" window.
  om <- tclServiceMode(TRUE)
  tkpack(logo)
  tkpack(tklabel(edge.frm, text = paste("Version", edge.library.version()), font = uidefaults$normalFont, fg = uidefaults$foreground, bg = uidefaults$background)) 
  tkpack(tklabel(edge.frm, text = "Created by the Storey Lab", font = uidefaults$normalFont, fg = uidefaults$foreground, bg = uidefaults$background)) 
  tkpack(tklabel(edge.frm, text = " ", font = uidefaults$normalFont, fg = uidefaults$foreground, bg = uidefaults$background)) 
  tkpack(edge.frm, fill = "x", side = "left")
  tkpack(options.frm, fill = "x")
  tkpack(message.frm)
  tclServiceMode(om)
  .Tcl("update idletasks")

  tkwm.focusmodel(edge.base, "active")

  post.txt.msg(message.txt, " ", bell=FALSE)
  post.txt.msg(message.txt, "Welcome to EDGE! http://faculty.washington.edu/jstorey/edge/", bell=FALSE)
  post.txt.msg(message.txt, "Coded by the Storey Lab at the University of Washington.", bell=FALSE)
  post.txt.msg(message.txt, "Messages will appear below. Enjoy.", bell=FALSE)
  post.txt.msg(message.txt, "",bell=FALSE)
  post.txt.msg(message.txt, "----------------------------------------------",bell=FALSE)
  post.txt.msg(message.txt, "",bell=FALSE)

  outputMsg <- NULL
  inform.impute.load.failed <- function(e)
  {
    post.txt.msg(message.txt, e$message)
    post.txt.msg(message.txt,
                 paste("\n(Scroll up for error message)\nPlease install the 'impute v1.0-4' package manually from CRAN in the local directory\n\n",
                       knnimp.pkgdir,
                       "\n\nor contact the software authors for assistance."))
    outputMsg <- paste("The 'impute' package could not be loaded.\n\nEDGE will still run, but will not be able to impute missing data.\n\nPlease see the EDGE message window for details.")
    tkmessageBox(message = outputMsg, icon="error", type="ok")
  }
  
  ## Try to load the impute package
  ## We now install impute with EDGE
#  tryCatch(try.load.impute.package(printmsg=function(...) post.txt.msg(message.txt, ...)), error=inform.impute.load.failed)
  
  ## Check whether an EDGE_DATA environment variable is specified
  datfile.env <- trim(Sys.getenv("EDGE_DATA"))
  datfile.loaded <- FALSE
  if(!is.null(datfile.env))
    {
      if(datfile.env == "")
        datfile.env <- NULL
      else
        {
          datfile.env <- removequotes(datfile.env)
          ## Get other parameters for loading data.
          nachar <- Sys.getenv("EDGE_DATA_NACHAR")
          hasdesc <- Sys.getenv("EDGE_DATA_HASDESC")
          hasdesc <- as.logical(hasdesc)
          hasdesc <- if(is.na(hasdesc)) FALSE else hasdesc
          ## Load the data file.
          post.txt.msg(message.txt,
                       paste("Loading data file from environment variable EDGE_DATA=",
                             datfile.env))
          readexpr.ui.func(datfile.env, nachar, hasdesc)
          datfile.loaded <- TRUE
        }
    }
  
  ## Check whether an EDGE_COV environment variable is specified
  covfile.env <- trim(Sys.getenv("EDGE_COV"))
  if(!is.null(covfile.env) && covfile.env != "")
    {
      if(is.null(datfile.env))
        {
          post.txt.msg(message.txt,
            "Warning: Ignoring EDGE_COV environment variable, because EDGE_DATA is not set")
        }
      else if(datfile.loaded)
        {
          covfile.env <- removequotes(covfile.env)

          ## Load the covariates file
          post.txt.msg(message.txt,
                       paste("Loading covariates file from environment variable EDGE_COV=",
                             covfile.env))
          readcov.ui.func(covfile.env, get.expression.data())
        }
       
    }

  last.warning <- NULL
  edge.frm
}


