.packageName <- "pmg"
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/BasicWidgets.R"
## Some helper functions to use proto to create widgets
## use proto to create widgets

## THIS USE PRE 0.4 proto version (.super instead of super())

                                        #require(proto)
#require(gWidgets)
#options("guiToolkit"="RGtk2")

## a Trait: uppercase
## a method, prototype: start with lowercase (new, show, makeButtons, ...)

## A Trait for a BasicGUI (with window, cancel, ok buttons)
## show() creates a new window we have 5 parts:
## menubar: set menubarList to a list for gmenu
## toolbar: set toolbarList to a list for gtoolbar
## body: override with makeBody(.,container).
## If widgetlist is provided, then generates "generic widget" like widget
## buttons: override [ok|cancel|help]ButtonHandler. Set NULL to not have
##   or write makeButtons(.,container)
## statusbar: set statusbarText to get

require(proto)
BasicGUI = proto(
  new = function(., message = "Basic GUI",...) {
     .$proto(message=message,...)
  },
  ## method to check if window has been drawn or destroyed
  isVisible = function(.,win = .$window) {
    if(!is.null(win) && is(win,"guiWidget") && isExtant(win)) return(TRUE)
    return(FALSE)
  },
  show = function(.,...) {
    ## ... passed to gwindow
    ## check if window is already there
    if(.$isVisible()) return()    
    ## window withing pmg, write this way to give flexibility outside of pmg
    if(exists("pmgWC"))
      .$window <- pmgWC$new(title = .$message,...)
    else
      .$window <- gwindow(title = .$message, ...)
    g = ggroup(horizontal=FALSE, cont=.$window, expand=TRUE)
    ## group for toolbar and menubar
    if(!is.null(.$menubarList) || !is.null(.$toolbarList)) {
      g1 = ggroup(horizontal=FALSE, container=g, expand=FALSE) 
      if(!is.null(.$menubarList)) .$menubar <- gmenu(.$menubarList, cont=g1)
      if(!is.null(.$toolbarList)) .$toolbar <- gtoolbar(.$toolbarList, style="icons",cont=g1)
      gseparator(cont=g1)
    }
    ## container for body --e xpand = TRUE
    g1 = ggroup(horizontal=FALSE, container=g, expand=TRUE) # expand
    .$makeBody(container = g1)
    .$makeButtons(container = g)
    if(!is.null(.$statusbarText))
      .$statusbar <- gstatusbar(.$statusbarText, cont=g)    
  },
  makeBody = function(., container) {
    glabel(.$message, cont=container)
    if(length(.$widgetList) > 0) {
      tbl <- glayout(cont=container)
      ctr = 1; 
      for(i in names(.$widgetList)) {
        tmp = .$widgetList[[i]]
        FUN = tmp[[1]]
        tmp[[1]] <- NULL
        tbl[ctr,1] = i
        tbl[ctr,2] <-
          (.$widgets[[i]] <- do.call(FUN, c(tmp, container = tbl)))
        ctr = ctr + 1
    }
      visible(tbl) <- TRUE
    }
  },
  makeButtons = function(., container) {
    ## add buttons help, cancel, ok (if xxxButtonHandler is not NULL)
    gseparator(cont=container)
    bg = ggroup(cont=container)
    if(!is.null(.$helpButtonHandler)) 
      helpButton = gbutton("help", cont=bg,  
        action = list(self=., super=.super),
        handler = .$helpButtonHandler)
    addSpring(bg)
    ## for these we take advantage of the fact that when we call
    ## the handlers this way the "." gets passed in via the first argument
    if(!is.null(.$cancelButtonHandler))
      cancelButton = gbutton("cancel", cont=bg,  
        action = list(self=., super=.super),
        handler = .$cancelButtonHandler)
    if(!is.null(.$clearButtonHandler))
      clearButton = gbutton("clear", cont=bg,  
        action = list(self=., super=.super),
        handler = .$clearButtonHandler)
    if(!is.null(.$okButtonHandler)) 
      okButton = gbutton("ok", cont=bg, 
        action = list(self=., super=.super),
        handler = .$okButtonHandler)
  },
  ## Notice, the signature includes the initial "."
  helpButtonHandler = NULL,             # make a handler if interested
  cancelButtonHandler = NULL,           # make non-NULL handler
  clearButtonHandler = NULL,           # make non-NULL handler
  okButtonHandler = function(.,h,...) {
    for(i in names(.$widgetList))  {
      ## store vals in props of super
#      .$.super$props[[i]] <- svalue(.$widgets[[i]]) # pre 0.4-0
     h$action$super$props[[i]] <- svalue(.$widgets[[i]])
    }
    dispose(.$window)
    },
  cancelButtonHandler = function(.,h,...) {
      dispose(.$window)
      ## others?
    },
  ## menubar
  menubarList = NULL,                   # non-null to have menubar
  menubar = NULL,
  getMenubar = function(.) return(.$menubar),
  setMenubar = function(.,lst) svalue(.$menubar) <- lst,
  ## toolbar
  toolbarList = NULL,                   # non-null to have toolbar
  toolbar = NULL,
  getToolbar = function(.) return(.$toolbar),
  setToolbar = function(.,lst) svalue(.$toolbar) <- lst,
  ## statusbar
  statusbarText = NULL,                 # non-null for statusbar
  statusbar = NULL,
  getStatusbar = function(.) return(.$statusbar),
  setStatusbar = function(.,value) svalue(.$statusbar) <- value,
  ## gwindow stuff
  window = NULL,                      # top-level gwindow
  ## properties
  message = "Basic widget",
  props = list(),                     # for storing properties of widgets
  ## for generic use
  widgetList =  list(),
  widgets = list()
  )

## Test it
##   BGTest = BasicGUI$new(message="Basic Widget Test",
##   widgetList = list(
##     edit = list(type="gedit",text="starting text"),
##     droplist = list(type = "gdroplist", items = letters),
##     slider = list(type = "gslider", value = 10),
##     radio = list(type="gradio", items = 1:3, horizontal=FALSE)
##  ))
## ## override handler so we don't set values in parent
## BGTest$okButtonHandler = function(.,handler,...) {
##   print(sapply(.$widgets,svalue)) ## or whatever else
##   dispose(.$window)
## }
## BGTest$show()  ## show the widget




## A Trait for a basic widget. To be embedded in a container
## Override the makeBody to change
BasicWidget = proto(
  new = function(., container=NULL, ...) {
    .$container = container
    ## setup widget
  },
  show = function(., ...) {
    ## show widget
    .$makeBody(container=.$container)
  },
  makeBody = function(.,container) {
    glabel("This space for rent", cont=container,...)
  },
  getValue = function(.,...) {
    if(is.null(.$widget))
      return(NA)
    else if(inherits(.$widget,"proto"))
      return(.$widget$getValue(...))
    else
      return(svalue(.$widget,...))
  },
  setValues = function(.,...) {},
  widget = NULL
)



## Make some Traits for extending gtable:
## SelectItemsWithOrder: two table panes, order is clear
## SelectItemsWithSelectionOrder: one table, order by click order
## UpDownTable: widget to move items up and down a table
## orderedGtable (return with order clicked, more subtle form of
## Up and Down Table (give buttons to move up and down an element)



## A Trait for a widget that allows one to select one or more from a
## list with order. -- only vectors, not data frames
SelectItemsWithOrder = BasicWidget$proto()
SelectItemsWithOrder$new = function(., container=NULL, allItems, curItems=c(), allItemsLabel = "", curItemsLabel = "") {
  if(missing(allItems)) {
    warn("Need to call with allItems and optionally  curItems")
    return()
  }
  .$proto(container=container, allItems=allItems, curItems=curItems,
          allItemsLabel = allItemsLabel, curItemsLabel=curItemsLabel)
} 
SelectItemsWithOrder$makeBody = function(.,container,...) {
  g = ggroup(cont = container)
  g1 = ggroup(horizontal=FALSE, cont=g)
  glabel(.$allItemsLabel, cont=g1)
  .$tbl1 = gtable(setdiff(.$allItems,.$curItems), cont = g1, expand=TRUE)
  .$leftRightArrow = gimage("rarrow",dirname="stock", cont=g)
  g1 = ggroup(horizontal=FALSE, cont=g)
  glabel(.$curItemsLabel, cont=g1)
  .$tbl2 = gtable(.$allItems, cont=g1, expand=TRUE)
  .$tbl2[] <- .$curItems
  bg = ggroup(horizontal=FALSE, cont=g)
  addSpace(bg,50)
  .$upArrow = gimage("uarrow", dirname="stock", cont=bg)
  .$downArrow = gimage("darrow", dirname="stock", cont=bg)

  ## assign widget
  .$widget <- .$tbl2

  ## add handlers
  addHandlerClicked(.$tbl1, handler = function(h,...) {
    svalue(.$leftRightArrow) <- "rarrow"
    .$leftRightArrowState = "right"
  })
  addHandlerClicked(.$tbl2, handler = function(h,...) {
    svalue(.$leftRightArrow) <- "larrow"
    .$leftRightArrowState = "left"
  })
  addHandlerClicked(.$leftRightArrow, handler = function(h,...) {
    from = .$tbl1
    to = .$tbl2
    if(.$leftRightArrowState == "left") {
      from = .$tbl2; to = .$tbl1
    }
    curSelected = svalue(from)
    if(length(curSelected) > 0) {
      from[] <- setdiff(from[],curSelected)
      toVals = to[]; toVals = toVals[!is.na(toVals)]
      to[] <- c(toVals,curSelected)
    }
  })
  addHandlerClicked(.$upArrow,  handler = function(h,...) {
    curItems = .$tbl2[]
    curSelected = svalue(.$tbl2)
    if(length(curSelected) > 0) {
      curInd = which(curSelected == curItems)
      if(curInd !=1) {
        a = curItems[curInd-1]
        .$tbl2[curInd-1] <- curSelected
        .$tbl2[curInd] <- a
        svalue(.$tbl2, index=TRUE) <- curInd - 1
      }
    }
  })
  addHandlerClicked(.$downArrow, handler = function(h,...) {
    curItems = .$tbl2[]; n<- length(curItems)
    curSelected = svalue(.$tbl2)
    if(length(curSelected) > 0) {
      curInd = which(curSelected == curItems)
      if(curInd !=n) {
        a = curItems[curInd+1]
        .$tbl2[curInd+1] <- curSelected
        .$tbl2[curInd] <- a
        svalue(.$tbl2, index=TRUE) <- curInd + 1
      }
    }
  })
}
SelectItemsWithOrder$getValue = function(.,...) {
  .$tbl2[]                              # override svalue
}

### TEST IT
## Use this to select contrasts
## allC = c('contr.helmert', 'contr.poly', 'contr.sum',
##      'contr.treatment')
## b =SelectItemsWithOrder$new(container=gwindow("test"), allItems=allC,
##   allItemsLabel = "Avail. contrasts",curItemsLabel="Selected contrasts")
## b$show()


##################################################
## A Trait for selecting from a gtable with order
## data.frames or vectors for items
## This is a more subtle ordering so that user barely notices
SelectItemsWithSelectionOrder = BasicWidget$proto()                    
SelectItemsWithSelectionOrder$new = function(.,container=NULL,items=c(),label="",chosencol=1,...) {
  .$proto(container=container, items=items, label=label, chosencol=1, value=c())
}
SelectItemsWithSelectionOrder$makeBody = function(.,container,...) {
  g = ggroup(horizontal=FALSE, cont=container,...)
  glabel(.$label, cont=g)
  .$widget = gtable(.$items, multiple=TRUE, chosencol=.$chosencol,
    cont=g, expand=TRUE)
  addHandlerClicked(.$widget, function(h,...) {
    ## set .$value based on number set. curvalue of value
    curVals = svalue(.$widget, index=TRUE)
    if(length(curVals) == 1)
      .$value = curVals
    else if(length(curVals) > 1) {
      ## add missing to value
      .$value = c(.$value, setdiff(curVals, .$value))
    }
    ## call click handler
    .$clickedHandler(h,...)
  })
  addHandlerDoubleclick(.$widget, function(h,...) .$doubleClickHandler(h,...))
}
SelectItemsWithSelectionOrder$clickedHandler = function(.,h,...) print(.$getValue(drop=FALSE))
SelectItemsWithSelectionOrder$doubleClickHandler = function(.,h,...) {}
SelectItemsWithSelectionOrder$getValue = function(.,...) {
  chosencol = tag(.$widget,"chosencol")
  return(.$widget[.$value,chosencol,...])
}
SelectItemsWithSelectionOrder$setValues = function(.,values) .$widget[,]<-values

## ## test it
## testit = SelectItemsWithSelectionOrder$new(
##   container=gwindow("test SelectItemsWithSelectionOrder"),
##   items = mtcars, label="mtcars")
## testit$show()

###################################################
## UpDownTable. This works with data frame
UpDownTable = BasicWidget$proto()
UpDownTable$new = function(., container=NULL, items=c(),label="") {
  .$proto(container=container, items=items, label=label)
} 
UpDownTable$makeBody = function(.,container,...) {
##  g = ggroup(cont = .$container)
  g = gframe(.$label, cont=container, expand=TRUE)
  lg = ggroup(horizontal=FALSE, cont=g, expand=TRUE)
##  glabel(.$label, cont=lg)
  .$widget = gtable(.$items, cont=lg, expand=TRUE)
  bg = ggroup(horizontal=FALSE, cont=g)
  addSpace(bg,50)
  .$upArrow = gimage("uarrow", dirname="stock", cont=bg)
  .$downArrow = gimage("darrow", dirname="stock", cont=bg)

  ## add handlers
  addHandlerClicked(.$upArrow,  handler = function(h,...) {
    curItems = .$widget[,]
    curInd = svalue(.$widget, index=TRUE)
    curSelected = curItems[curInd,,drop=FALSE]
    if(!is.null(curInd)) {
      if(curInd !=1) {
        a = curItems[curInd-1,,drop=FALSE]
        .$widget[curInd-1,] <- curSelected
        .$widget[curInd,] <- a
        svalue(.$widget, index=TRUE) <- curInd - 1
      }
    }
  })
  addHandlerClicked(.$downArrow, handler = function(h,...) {
    curItems = .$widget[,]
    if(is.data.frame(curItems))
      n <- dim(curItems)[1]
    else
      n<- length(curItems)
    curInd = svalue(.$widget, index=TRUE)
    curSelected = curItems[curInd,,drop=FALSE]
    if(!is.null(curInd)) {
      if(curInd !=n) {
        a = curItems[curInd+1,,drop=FALSE]
        .$widget[curInd+1,] <- curSelected
        .$widget[curInd,] <- a
        svalue(.$widget, index=TRUE) <- curInd + 1
      }
    }
  })
  addHandlerClicked(.$widget, action=list(self=.,super=.super), handler = .$clickedHandler)
  addHandlerDoubleclick(.$widget, action=list(self=.,super=.super), handler = .$doubleClickHandler)
}
UpDownTable$getValue = function(.,...) {
  .$widget[,]                              # override svalue
}
UpDownTable$setValues = function(.,value,...) .$widget[,]<-value
UpDownTable$clickedHandler = function(.,h,...) {}
UpDownTable$doubleClickHandler = function(.,h,...) {}


## ### TEST IT
## ## Use this to select contrasts
## allC = c('contr.helmert', 'contr.poly', 'contr.sum',
##      'contr.treatment')
## b =UpDownTable$new(container=gwindow("test"), items = mtcars, label="test")
## b$clickedHandler = function(.,h,...) print(.$getValue())
## b$show()



### Test
##g = SelectItemsWithSelectionOrder$new(items = letters, container=gwindow("test"))
##g$show()

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/WindowCollector.R"
## Store windows for gWidgets

## require(proto)
## require(gWidgets)
## options("guiToolkit"="RGtk2")
## source("~/pmg/pmg/R/BasicWidgets.R")


## the windowcollector is a place to organize windows within pmg
## methods
## new -- returns a new window
## getWindow(ID) -- returns the window with ID
## delete(win,[ID]) -- delete that window
## register(win) -- register window. Done by new()
## show() -- show the table with the windows. Double clicking an entry raises the window. SHould have a way to delete the window.


winCollector = BasicGUI$new("message"="Open windows")
winCollector$makeBody = function(.,container) {
  g = ggroup(horizontal = FALSE, cont=container, expand=TRUE)
  glabel("window list", cont=g)
  .$tbl <- gtable(.$summary(), chosencol=2,cont = g, expand=TRUE)
  ## add stuff, handlers buttons
  ## double click -- raise
  addHandlerDoubleclick(.$tbl, function(h,...) {
    ID = svalue(h$obj)
    if(length(ID) == 0) return(TRUE)
    w <- .$getWindow(ID)
    focus(w) <- TRUE
  })
}
winCollector$makeButtons = function(.,container) {
  bg = ggroup(cont=container)
  addSpring(bg)
  gbutton("cancel",cont=bg, handler = function(h,...) dispose(.$window))
  addSpace(bg,10)
  gbutton("Raise", cont=bg, handler = function(h,...) {
    ID = svalue(.$tbl)
    if(length(ID) == 0) return(TRUE)    
    w = .$getWindow(ID)
    focus(w) <- TRUE
  })
  gbutton("Delete window", cont=bg, handler= function(h,...) {
    ID = svalue(.$tbl)
    if(length(ID) == 0) return(TRUE)    
    w = .$getWindow(ID)
    dispose(w)
  })
}
winCollector$updateBody = function(.) {
  ## check that it is visible
  if(.$isVisible())
    .$tbl[,] <- .$summary()
}

winCollector$ctr = 0                    # for the ID
winCollector$list = list()              # stores windows
winCollector$register = function(.,win) {    # register a window
  if(!.$isVisible(win)) return(NA)
  
  if(!is.null(tag(win,"wcID"))) {
    ## already added
    return(NA)
  }

  .$ctr = .$ctr + 1
  ID = as.character(.$ctr )
  tag(win,"wcID") <- ID
  .$list[[ID]] <- win
  .$updateBody()
  return(ID)
}
## delete from list, dispose is separate
winCollector$delete = function(.,win,ID=NULL) { # delete window from list
  if(is.null(ID))
    ID = tag(win,"wcID")
  if(is.null(ID)) {
    cat("Window not among list\n")
    return(FALSE)
  }
  win = .$list[[ID]]
  .$list[[ID]] <- NULL

  if(.$isVisible(win)) dispose(win)

  .$updateBody()  
  return(TRUE)
}
winCollector$summary = function(.) { ## return df with window names
  if(length(.$list) > 0) {
    d = data.frame(title = sapply(.$list,svalue),
      ID = sapply(.$list,function(o) tag(o,"wcID")),
      stringsAsFactors=FALSE
      )
    d = d[sapply(d[,2],function(ID) .$isVisible(.$getWindow(ID))),]
  } else {
    d = data.frame(title = c(""), ID = "", stringsAsFactors=FALSE)
  }
  return(d)
}

## new window, added to 
winCollector$new = function(.,...) {
  w <- gwindow(...)
  ID <- .$register(w)
  addHandlerUnrealize(w,action=ID, handler = function(h,...) {
    .$delete(ID=h$action)
  })
  addhandlerdestroy(w, action=ID, handler = function(h,...) {
    .$delete(ID=h$action)
  })
    
  return(w)                             # return window
}
## get window From ID
winCollector$getWindow = function(.,ID) {
  if(length(ID) == 0 || is.na(ID) || is.null(ID) )
    return(NA)
  .$list[[ID]]
}

## closeAll
winCollector$closeAll = function(.) {
  ID = tag(.$window,"wcID")
  d = .$summary
  sapply(d$ID, function(i) .$delete(i))
}

## give a shorter name
pmgWC = winCollector
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/YN.R"
## functions by Yvonnick Noel yvonnick.noel@uhb.fr

## TODO
## * histogramAndDensity -- get density drawn right
## probabilityCalculator -- get Type of calculation spelled correctly
## * speed up the drawing
## constructionOFNormal -- add handler to no. of variables., ... m and n
histogramAndDensity = function(container=gwindow("Window 1: idea of a density")) {
  library(gWidgets)

  availDists = c(Uniform = "unif", Normal = "norm", Gamma = "gamma")
  theParams = list(
    "norm" = c("mean","sd",0,1),
    "t" = c("df","ncp","",0),
    "chisq" = c("df","ncp","",0),
    "f" = c("df1","df2","",""),
    "binom"=c("size","prob",1,.5),
    "pois" = c("lambda","",1,""),
    "gamma" = c("shape","rate","",1),
    "beta" = c("shape1","shape2","",""),
    "unif" = c("min","max",0,1)
    )
  
  
  updatePlot = function(h, ...) {
    ### makeEmptyPlot - windows issue
    plot.new()
    plot.window(xlim=c(0,1),ylim=c(0,1))

    
    
    rfunc = paste("r",availDists[svalue(distribution)],sep="")
    dfunc = paste("d",availDists[svalue(distribution)],sep="")
    x = do.call(rfunc, list(svalue(sampleSize),svalue(param1),svalue(param2)))
    if(nchar(svalue(cutpoints))) {
      breaks = unlist(strsplit(svalue(cutpoints)," "))
      breaks = breaks[breaks!=""]
      if(!length(breaks)) breaks="sturges"
      else breaks = as.numeric(breaks)
    }
    else { breaks = "sturges" }

    hh=hist(x,breaks=breaks,plot=FALSE)
    ## now plot histogram
    if(svalue(displayWhat) == "Counts") {
      plot(hh,
           main = paste("Distribution",svalue(distribution)),
           ylab=svalue(displayWhat)
           ) 
    } else if(svalue(displayWhat) == "Frequencies") {
      hh$counts = hh$counts / svalue(sampleSize)
      plot(hh,
           main = paste("Distribution",svalue(distribution)),
           ylab=svalue(displayWhat)
           ) 
    } else {
      hist(x,probability=TRUE,
           main = paste("Distribution",svalue(distribution)),
           ylab=svalue(displayWhat)
           ) 
      addDensity()
    }
  }

  addDensity = function(...) {
    dfunc = paste("d",availDists[svalue(distribution)],sep="")
    dFunc = get(dfunc)
    curve(dFunc(x, svalue(param1), svalue(param2)), lwd=2, col="red",add=T)
  }

  ## the distribution used
  distribution = gdroplist(names(availDists),horizontal=FALSE,handler=updatePlot)
  addhandlerchanged(distribution, handler = function(h,...) {
    theDist = availDists[svalue(h$obj)]
    svalue(param1label) = theParams[[theDist]][1]
    svalue(param1) = theParams[[theDist]][3]
    
    if(theParams[[theDist]][2] == "") {
      svalue(param2label) = theParams[[theDist]][2]
      svalue(param2) = ""      
      enabled(param2) <- FALSE
    } else {
      enabled(param2) <- TRUE
      svalue(param2label) = theParams[[theDist]][2]
      svalue(param2) = theParams[[theDist]][4]
    }
  })
  


  sampleSize = gradio(c(500, 5000, 50000),handler=updatePlot)
displayWhat = gradio(c("Counts","Frequencies","Density of frequencies"),handler=updatePlot)
displayFunc = gcheckbox("Theoretical density",handler=addDensity)

  param1label = glabel(theParams[[availDists[1]]][1])
  param2label = glabel(theParams[[availDists[1]]][2])
  param1 = gedit(theParams[[availDists[1]]][3],width=5,coerce.with=rpel)
  param2 = gedit(theParams[[availDists[1]]][4],width=5,coerce.with=rpel)

  cutpoints = gedit("",coerce.with=rpel)


BigGroup = ggroup(cont = container)
group = ggroup(horizontal = FALSE, container = BigGroup)


tmp = gframe("Distribution", container = group)
distribGroup = glayout(container=tmp)
distribGroup[1,1]=glabel("Law")
distribGroup[1,2]=distribution
distribGroup[2,1]=param1label
distribGroup[2,2]=param1
distribGroup[3,1]=param2label
distribGroup[3,2]=param2
visible(distribGroup)=TRUE

tmp = gframe("Sample size", container = group)
add(tmp, sampleSize)

tmp = gframe("Display", container = group)
add(tmp,displayWhat)
#add(tmp,displayFunc)

tmp = gframe("Cutpoints", container = group)
add(tmp,cutpoints,expand=TRUE)

addSpring(group)

buttonGroup=ggroup(container=group)

  if(missing(container))
    gbutton("cancel", container=buttonGroup, handler = function(h,...) dispose(container))

  addSpring(buttonGroup)
gbutton("display",container=buttonGroup, handler=updatePlot)

add(BigGroup, ggraphics())

  invisible(BigGroup)
  
}



## probability calculator
probabilityCalculator = function(container=gwindow("Probability caculator")) {

  library(gWidgets)

availDists = c(Normal="norm",Student="t","Chi-2"="chisq",Fisher="f",Binomial="binom",Poisson="pois",Gamma="gamma",Beta="beta")

  theParams = list(
    "norm" = c("mean","sd",0,1),
    "t" = c("df","ncp","",0),
    "chisq" = c("df","ncp","",0),
    "f" = c("df1","df2","",""),
    "binom"=c("size","prob",1,.5),
    "pois" = c("lambda","",1,""),
    "gamma" = c("shape","rate","",1),
    "beta" = c("shape1","shape2","",""),
    "unif" = c("min","max",0,1)
    )
  
initOptions = function(h, ...) {

 r2s.distrib = svalue(distribution)
 r2s.is1P = r2s.distrib %in% c("Student","Chi-2","Poisson")
 if(r2s.is1P) svalue(param2)=""
 svalue(result)=""
 svalue(value)=""

}

updatePlot = function(h, ...) {


  
  r2s.distrib = svalue(distribution)
  r2s.param1 = svalue(param1)
  r2s.param2 = svalue(param2)
  r2s.value = svalue(value)


 r2s.p = svalue(calcWhat) == "Find quantile"
 r2s.right = svalue(side)=="to right"

 r2s.isDiscrete = r2s.distrib %in% c("Binomial","Poisson")
 r2s.is1P = r2s.distrib %in% c("Student","Chi-2","Poisson")
 r2s.is01 = function(x) (x>=0)&&(x<=1)
 r2s.isInteger = function(x) abs(x)==round(x)
 r2s.probf = availDists

 r2s.dfunction = eval(parse(text=paste("d",r2s.probf[r2s.distrib],sep="")))
 r2s.pfunction = eval(parse(text=paste("p",r2s.probf[r2s.distrib],sep="")))
 r2s.qfunction = eval(parse(text=paste("q",r2s.probf[r2s.distrib],sep="")))
 r2s.rfunction = eval(parse(text=paste("r",r2s.probf[r2s.distrib],sep="")))

 # Chosen distribution has two parameters
 if(!r2s.is1P) {
   # Check parameter values
   if(r2s.distrib=="Binomial") {
     stopifnot(r2s.isInteger(r2s.param1) && r2s.is01(r2s.param2)) }
   if(r2s.distrib=="Fisher") {
     stopifnot(r2s.isInteger(r2s.param1) && r2s.isInteger(r2s.param2)) }

   if(r2s.p) {
     r2s.prob = r2s.value
     if(!r2s.isDiscrete) {
       if(r2s.right) r2s.value = r2s.qfunction(1-r2s.prob,r2s.param1,r2s.param2)
       else          r2s.value = r2s.qfunction(r2s.prob,r2s.param1,r2s.param2)
     } else {
       if(r2s.right) r2s.value = r2s.qfunction(1-r2s.prob,r2s.param1,r2s.param2)
       else          r2s.value = r2s.qfunction(r2s.prob,r2s.param1,r2s.param2)
     }} else {
       if(!r2s.isDiscrete) {
         if(r2s.right) { r2s.prob = 1-r2s.pfunction(r2s.value,r2s.param1,r2s.param2) } else {
                         r2s.prob = r2s.pfunction(r2s.value,r2s.param1,r2s.param2)}} else {
         if(r2s.right) { r2s.prob = 1-r2s.pfunction(r2s.value-1,r2s.param1,r2s.param2) } else {
                         r2s.prob = r2s.pfunction(r2s.value,r2s.param1,r2s.param2)}}}

   r2s.dens = r2s.dfunction(r2s.value,r2s.param1,r2s.param2)
 # Chosen distribution has only one parameter
 } else {

   svalue(param2)=""

   if(r2s.distrib=="Student") {
     stopifnot(r2s.isInteger(r2s.param1)) }
   if(r2s.distrib=="Chi-2") {
     stopifnot(r2s.isInteger(r2s.param1)) }

   if(r2s.p) {
     r2s.prob = r2s.value
     if(!r2s.isDiscrete) {
       if(r2s.right) r2s.value = r2s.qfunction(1-r2s.prob,r2s.param1)
       else          r2s.value = r2s.qfunction(r2s.prob,r2s.param1)
     } else {
       if(r2s.right) r2s.value = r2s.qfunction(1-r2s.prob,r2s.param1)
       else          r2s.value = r2s.qfunction(r2s.prob,r2s.param1)
     }} else {
       if(!r2s.isDiscrete) {
         if(r2s.right) { r2s.prob = 1-r2s.pfunction(r2s.value,r2s.param1) } else {
                         r2s.prob = r2s.pfunction(r2s.value,r2s.param1)}} else {
         if(r2s.right) { r2s.prob = 1-r2s.pfunction(r2s.value-1,r2s.param1) } else {
                         r2s.prob = r2s.pfunction(r2s.value,r2s.param1)}}}

   r2s.dens = r2s.dfunction(r2s.value,r2s.param1)
 }

 # Result
 svalue(result)=ifelse(r2s.p,
         paste("x =",format(r2s.value,digits=4, nsmall=4)),
         paste("p =",format(r2s.prob,digits=4, nsmall=4)))

 # Affichage
 r2s.xlab="X"
 r2s.title = paste("Distribution :",r2s.distrib)
 r2s.ylab = expression(f(X==x))
 from = 0

 if(!r2s.is1P) {
   if(!r2s.isDiscrete) {
     from = ifelse(r2s.distrib=="Normal",r2s.param1-4*r2s.param2,0)
     to = ifelse(r2s.distrib=="Normal",r2s.param1+4*r2s.param2,max(r2s.rfunction(1000,r2s.param1,r2s.param2)))
     curve(r2s.dfunction(x,r2s.param1,r2s.param2),n=1000,from=from,to=to,lwd=2,main=r2s.title,xlab=r2s.xlab,ylab=r2s.ylab)
     if(!r2s.right) {
       r2s.z = seq(from,r2s.value,len=1000)
       for(i in r2s.z) lines(rbind(c(i,0),c(i,r2s.dfunction(i,r2s.param1,r2s.param2))),lwd=2,col="red")
     } else {
         r2s.z = seq(r2s.value,to,len=1000)
         for(i in r2s.z) lines(rbind(c(i,0),c(i,r2s.dfunction(i,r2s.param1,r2s.param2))),lwd=2,col="red") }
     r2s.dum=curve(r2s.dfunction(x,r2s.param1,r2s.param2),add=TRUE,n=1000,from=from,to=to,lwd=2,main=r2s.title,xlab=r2s.xlab,ylab=r2s.ylab)
   } else {
     from = 0
     to = ifelse(r2s.distrib=="Binomial",r2s.param1,max(r2s.rfunction(1000,r2s.param1,r2s.param2)))
     r2s.z = 0:to
     plot(r2s.z,r2s.dfunction(r2s.z,r2s.param1,r2s.param2),type="h",lwd=2,main=r2s.title,xlab=r2s.xlab,ylab=r2s.ylab)
     if(!r2s.right) {
       for(i in 0:(r2s.value-1)) { lines(rbind(c(i,0),c(i,r2s.dfunction(i,r2s.param1,r2s.param2))),lwd=2,col="red") }
       lines(rbind(c(r2s.value,0),c(r2s.value,r2s.prob-r2s.pfunction(r2s.value-1,r2s.param1,r2s.param2))),lwd=2,col="red")
     } else {
       for(i in r2s.param1:(r2s.value+1)) {
       lines(rbind(c(i,0),c(i,r2s.dfunction(i,r2s.param1,r2s.param2))),lwd=2,col="red") }
       lines(rbind(c(r2s.value,0),c(r2s.value,r2s.prob-1+r2s.pfunction(r2s.value,r2s.param1,r2s.param2))),lwd=2,col="red")}}
 # One parameter distributions
 } else {
   if(!r2s.isDiscrete) {
     from = ifelse(r2s.distrib=="Student",min(r2s.rfunction(1000,r2s.param1)),0)
     to = max(r2s.rfunction(1000,r2s.param1))
     curve(r2s.dfunction(x,r2s.param1),n=1000,from=from,to=to,lwd=2,main=r2s.title,xlab=r2s.xlab,ylab=r2s.ylab)
     if(!r2s.right) {
       r2s.z = seq(from,r2s.value,len=1000)
       for(i in r2s.z) lines(rbind(c(i,0),c(i,r2s.dfunction(i,r2s.param1))),lwd=2,col="red")
     } else {
         r2s.z = seq(r2s.value,to,len=1000)
         for(i in r2s.z) lines(rbind(c(i,0),c(i,r2s.dfunction(i,r2s.param1))),lwd=2,col="red") }
     r2s.dum=curve(r2s.dfunction(x,r2s.param1),add=TRUE,n=1000,from=from,to=to,lwd=2,main=r2s.title,xlab=r2s.xlab,ylab=r2s.ylab)
   } else {
     from = 0
     to = max(r2s.rfunction(1000,r2s.param1))
     r2s.z = 0:to
     plot(r2s.z,r2s.dfunction(r2s.z,r2s.param1),type="h",lwd=2,main=r2s.title,xlab=r2s.xlab,ylab=r2s.ylab)
     if(!r2s.right) {
       for(i in 0:(r2s.value-1)) { lines(rbind(c(i,0),c(i,r2s.dfunction(i,r2s.param1))),lwd=2,col="red") }
       lines(rbind(c(r2s.value,0),c(r2s.value,r2s.prob-r2s.pfunction(r2s.value-1,r2s.param1))),lwd=2,col="red")
     } else {
       for(i in to:(r2s.value+1)) {
       lines(rbind(c(i,0),c(i,r2s.dfunction(i,r2s.param1))),lwd=2,col="red") }
       lines(rbind(c(r2s.value,0),c(r2s.value,r2s.prob-1+r2s.pfunction(r2s.value,r2s.param1))),lwd=2,col="red")}}
 }

}

  distribution = gdroplist(names(availDists),horizontal=FALSE,handler=initOptions)
  addhandlerchanged(distribution,handler = function(h,...) {
    theDist = availDists[svalue(h$obj)]

    svalue(param1label) = theParams[[theDist]][1]
    svalue(param1) = theParams[[theDist]][3]

    if(theParams[[theDist]][2] == "") {
      svalue(param2label) = theParams[[theDist]][2]
      svalue(param2) = ""      
      enabled(param2) <- FALSE
    } else {
      enabled(param2) <- TRUE
      svalue(param2label) = theParams[[theDist]][2]
      svalue(param2) = theParams[[theDist]][4]
    }
  })


  calcWhat = gradio(c("Find probability","Find quantile"))
side = gradio(c("to left","to right"))
  param1label = glabel(theParams[[availDists[1]]][1])
  param2label = glabel(theParams[[availDists[1]]][2])
  param1 = gedit(theParams[[availDists[1]]][3],width=5,coerce.with=rpel)
  param2 = gedit(theParams[[availDists[1]]][4],width=5,coerce.with=rpel)

  value  = gedit(width=15, handler = updatePlot,coerce.with=rpel)
  result = glabel("")

BigGroup = ggroup(cont = container)
group = ggroup(horizontal = FALSE, container = BigGroup)

tmp = gframe("Distribution", container = group)
distribGroup = glayout(container=tmp)
distribGroup[1,1]=glabel("Law")
distribGroup[1,2]=distribution
distribGroup[2,1]=param1label
distribGroup[2,2]=param1
distribGroup[3,1]=param2label
distribGroup[3,2]=param2
visible(distribGroup)=TRUE

tmp = gframe("Type of calculation", container = group)
add(tmp,calcWhat)

tmp = gframe("Cumulative", container = group)
add(tmp,side)

tmp = gframe("Result", container = group)
  resultGroup = glayout()
  resultGroup[1,1]=glabel("Value")
  resultGroup[1,2]=value
  resultGroup[2,1]=glabel("Result")
  resultGroup[2,2]=result
  visible(resultGroup) <- TRUE
  add(tmp,resultGroup)

addSpring(group)

buttonGroup=ggroup(container=group)
  if(missing(container))
    gbutton("cancel", container=buttonGroup, handler = function(h,...) dispose(container))
addSpring(buttonGroup)
gbutton("update",container=buttonGroup, handler=updatePlot)

add(BigGroup, ggraphics())
  invisible(BigGroup)
}

constructionOfNormal = function(container = gwindow("Construction of normal from X1 + X2 + ... + Xn")) {
  
  library(gWidgets)
  
  availDists = c(Uniform = "unif", Binomial = "binom", Normal = "norm")
  theParams = list(
    "norm" = c("mean","sd",0,1),
    "t" = c("df","ncp","",0),
    "chisq" = c("df","ncp","",0),
    "f" = c("df1","df2","",""),
    "binom"=c("size","prob",1,.5),
    "pois" = c("lambda","",1,""),
    "gamma" = c("shape","rate","",1),
    "beta" = c("shape1","shape2","",""),
    "unif" = c("min","max",0,1)
    )
  
  updatePlot = function(h, ...) {
    
    rfunc = paste("r",availDists[svalue(distribution)],sep="")
    y = do.call(rfunc, list(svalue(sampleSize)*svalue(nvar),
      svalue(param1),svalue(param2)))
    z = rowSums(matrix(y,svalue(sampleSize),svalue(nvar)))
    
    xlab="Values of the variable"
    title = paste("Distribution :",svalue(distribution))
    ylab = "Densities/Probabilities"
 if(svalue(distribution)!="Binomial") {
   hist(z,freq=FALSE,main=title,xlab=xlab,ylab=ylab)
 }
 else {
   res = plot(table(z)/svalue(sampleSize),main=title,xlab=xlab,ylab=ylab)
 }
 if(svalue(displayFunc)) curve(dnorm(x,mean(z),sd(z)),from=min(z),to=max(z),add=TRUE,lwd=2,col=2)
}

distribution = gdroplist(names(availDists),horizontal=FALSE)
    addhandlerchanged(distribution,handler = function(h,...) {
    theDist = availDists[svalue(h$obj)]

    svalue(param1label) = theParams[[theDist]][1]
    svalue(param1) = theParams[[theDist]][3]

    if(theParams[[theDist]][2] == "") {
      svalue(param2label) = theParams[[theDist]][2]
      svalue(param2) = ""      
      enabled(param2) <- FALSE
    } else {
      enabled(param2) <- TRUE
      svalue(param2label) = theParams[[theDist]][2]
      svalue(param2) = theParams[[theDist]][4]
    }
  })



  param1label = glabel(theParams[[availDists[1]]][1])
  param2label = glabel(theParams[[availDists[1]]][2])
  param1 = gedit(theParams[[availDists[1]]][3],width=5,coerce.with=rpel)
  param2 = gedit(theParams[[availDists[1]]][4],width=5,coerce.with=rpel)


  sampleSize  =  gedit("500",width=5,coerce.with=rpel)
  nvar  =  gedit(1, width=5, handler=updatePlot,coerce.with=rpel)

  displayFunc = gcheckbox("Show normal law",handler=updatePlot)


BigGroup = ggroup(cont = container)
group = ggroup(horizontal = FALSE, container = BigGroup)


tmp = gframe("Distribution", container = group)
distribGroup = glayout(container=tmp)
distribGroup[1,1]=glabel("Law")
distribGroup[1,2]=distribution
distribGroup[2,1]= param1label
distribGroup[2,2]=param1
distribGroup[3,1]= param2label
distribGroup[3,2]=param2
visible(distribGroup)=TRUE

tmp = gframe("Score", container = group)
distribSample = glayout(container=tmp)
distribSample[1,1]=glabel("n for: X1 + ... + Xn")
distribSample[1,2]=nvar
distribSample[2,1]=glabel("Number of simulations")
distribSample[2,2]=sampleSize
visible(distribSample)=TRUE

tmp = gframe("update", container = group)
add(tmp,displayFunc)

addSpring(group)

buttonGroup=ggroup(container=group)
  if(missing(container))
    gbutton("cancel", container=buttonGroup, handler = function(h,...) dispose(container))
addSpring(buttonGroup)
gbutton("update",container=buttonGroup, handler=updatePlot)

add(BigGroup, ggraphics())
  invisible(BigGroup)
}
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/aaa.pmg.gw.R"
require(proto)
## stuff to make generic widgets


## some predefined types for GenericWidget
default.color.list = list(
  type="gdroplist",
  items=c("","\"black\"","\"blue\"","\"red\"","\"yellow\"","\"brown\"","\"green\"","\"pink\"","NULL"),
  editable=TRUE
  )
lty.list = list(
  type = "gdroplist",
  items = c("\"solid\"","\"dashed\"","\"dotted\"","\"dotdash\"","\"longdash\"","\"twodash\"","\"blank\""),
  editable=TRUE
  )
pch.list = list(
  type = "gspinbutton",
  from=0,
  to=26,
  by=1,
  value=1
  )
EMPTY.list = list(
  type = "gedit",
  text = ""
  )
BLANK.list = list(                      # for putting in a space
  type = "glabel",
  text = ""
  )
NULL.list = list(
  type = "gedit",
  text = "NULL"
  )
FALSE.list = list(
  type = "gradio",
  items = c("TRUE","FALSE"),
  index = FALSE,
  selected = 2
  )
TRUE.list = list(
  type = "gradio",
  index = FALSE,
  items = c("TRUE","FALSE")
  )
emptyTRUE.list = list(
  type = "gdroplist",
  items = c("","TRUE","FALSE")
  )
alternative.list = list(
  type="gdroplist",
  items=c("\"two.sided\"","\"less\"","\"greater\"")
  )
conf.level.list = list(
  type = "gdroplist",
  items = c(0.95, 0.99, 0.90, 0.80),
  editable = TRUE
  )
labels.list = list(
    main = EMPTY.list,
    sub = BLANK.list,
    xlab = EMPTY.list,
    ylab = EMPTY.list
  )

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/dHtest.R"
## write htest interface for showing t.test, etc. with drop

## This is kinda ugly!
## TODO
## chisq.test, fisher.test, "mantelhaen.test" "mcnemar.test"
## * ---- isn't working names is giving unique guys
## 



dTestsDialog = function() {

  tests = list(
    "1-sample test of proportion" = "gui.prop.test",
    "1-sample exact test of proportion" = "gui.binom.test",
    "2-sample test of proportion" = "gui.prop.test.2sample",
    "2-sample exact test of proportion" = "gui.binom.test.2sample",
    "-----" = "-----",
    ##
    "1-sample t-test"="gui.t.test",
    "1-sample signed rank test"="gui.wilcox.signed.rank.test",
    "2-sample t-test" =   "gui.t.test.2.sample",
    "2-sample t-test var. equal" = "gui.t.test.2.sample.var.equal",
    "2-sample t-test, formula" =   "gui.t.test.2.sample.formula",
    "2-sample t-test var. equal, formula" = "gui.t.test.2.sample.var.equal.formula",
    "2-sample rank sum test" = "gui.wilcox.rank.sum.test",
    "----" = "-----",
    ##
    "Oneway ANOVA" = "gui.oneway.test",
    "Kruska-Wallis test" = "gui.kruskal.test",
    "---" = "-----",
    ##
    "Correlation test" = "gui.cor.test",
    "--" = "-----",
    ##
    "Test of variances" = "gui.var.test",
    "Ansari test" = "gui.ansari.test",
    "Bartlett test" = "gui.bartlett.test",
    "Fligner test" = "gui.fligner.test",
    "Mood test" = "gui.mood.test",
    ##
    "------" = "-----",
    "2-sample Kolmogorov-Smirnov test" = "gui.ks.test",
    "Shapiro.test" = "gui.shapiro.test"
    
    )
  
  dialogList = list()
#  for(i in names(tests)) {
#    tmp = tests[[i]]
#    if(length(tmp) == 1)
#      dialogList[[i]] <- do.call(tmp,list())
#    else
#      dialogList[[i]] <- do.call(tmp[1],tmp[2]) # tmp a list with args
#  }
  dialogList[["FirstOne"]] = glabel("Select a test from popup")
  
  
  win = pmgWC$new("Dynamic tests",
    width=400,height=300,
    handler = function(h,...) {
    for(i in dialogList) {
      ids = tag(i,"dropHandlers")
      if(!is.null(ids))
        removehandler(i,ids)
    }})
  gp = ggroup(horizontal=FALSE, container=win, raise.on.dragmotion = TRUE)
  popupGroup = ggroup(container=gp)
  addSpring(popupGroup)
  theNames = c("",names(tests))
  testPopup = gdroplist(theNames, container=popupGroup)
  
  testWindow = ggroup(container=gp)
  add(testWindow,dialogList[["FirstOne"]], expand=TRUE)
  tag(testWindow,"dialogList") <- dialogList
  tag(testWindow,"currentTest") <- dialogList[["FirstOne"]]
  
  addhandlerchanged(testPopup, handler = function(h,...) {
    popupValue = svalue(testPopup)
    if(!is.empty(popupValue) || popupValue != "-----") {
      delete(testWindow,tag(testWindow,"currentTest"))
      dialogList = tag(testWindow, "dialogList")
##      if(is.null(dialogList[[popupValue]])) {
      if(! popupValue %in% names(dialogList)) {
        dialogList[[popupValue]] <- do.call(tests[[popupValue]],list())
        tag(testWindow,  "dialogList") <- dialogList
      }
      add(testWindow,dialogList[[popupValue]], expand=TRUE)
      tag(testWindow,"currentTest") <-  dialogList[[popupValue]]
  }
  })

}




## examples of standalone usage
gui.oneway.test = function(container = NULL) {
  gui.htest("oneway.test", type="x~f",
                   template = oneway.test(mtcars$mpg ~ as.factor(mtcars$cyl)),
                   container = container)
}

gui.kruskal.test = function(container = NULL) {
  gui.htest("kruskal.test", type="x~f",
                   template = kruskal.test(mtcars$mpg ~ as.factor(mtcars$cyl)),
                   container = container)
}

gui.bartlett.test = function(container =NULL) {
  gui.htest("bartlett.test", type="x~f",
                   template = bartlett.test(mtcars$mpg ~ as.factor(mtcars$cyl)),
                   container = container)
}

gui.fligner.test = function(container = NULL) {
  gui.htest("fligner.test", type="x~f",
                   template = fligner.test(mtcars$mpg ~ as.factor(mtcars$cyl)),
                   container = container)
}


gui.t.test = function(container = NULL) {
  gui.htest("t.test",type="univariate",
            template=t.test(rnorm(100)),
            container = container)
}
gui.t.test.2.sample = function(container= NULL) {
  gui.htest("t.test",type="bivariate",
            template=t.test(rnorm(100), rnorm(100)),
            container = container)
}
gui.t.test.2.sample.formula = function(container= NULL) {
  gui.htest("t.test",type="x~f",
            template=t.test(rnorm(100) ~ factor(sample(1:2, 100,T))),
            container = container)
}
gui.t.test.2.sample.var.equal = function(container=NULL) {
  gui.htest("t.test",type="bivariate",
            template=t.test(rnorm(100), rnorm(100), var.equal=TRUE),
            extra.args = list("var.equal"=TRUE),
            container = container)
}
gui.t.test.2.sample.var.equal.formula = function(container=NULL) {
  gui.htest("t.test",type="x~f",
            template=t.test(rnorm(100) ~ factor(sample(1:2, 100,T)), var.equal=TRUE),
            extra.args = list("var.equal"=TRUE),
            container = container)
}
gui.wilcox.signed.rank.test = function(container=NULL) {
  gui.htest("wilcox.test",type="univariate",
            template=wilcox.test(rnorm(100)),
            container = container)
}
gui.wilcox.rank.sum.test = function(container=NULL) {
  gui.htest("wilcox.test",type="bivariate",
            template=wilcox.test(rnorm(100),rnorm(100)),
            container = container)
}

gui.ks.test = function(container=NULL) {
  gui.htest("ks.test",type="bivariate",
            template=ks.test(rnorm(100),rnorm(100)),
            container = container)
}

gui.ansari.test = function(container=NULL){
  gui.htest("ansari.test",type="bivariate",
            template=ansari.test(rnorm(100),rnorm(100)),
            container = container)
}

gui.cor.test = function(container=NULL) {
  gui.htest("cor.test",type="bivariate",
                   template=cor.test(rnorm(100),rnorm(100), method="pearson"),
                   extra.args=list("method"="pearson"),
                   container = container)
}

gui.mood.test = function(container=NULL) {
  gui.htest("mood.test",type="bivariate",
                   template=mood.test(rnorm(100),rnorm(100)),
                   container = container)
}

Shapiro.test = function(x,...) shapiro.test(x)
gui.shapiro.test = function(container=NULL) {
  gui.htest("Shapiro.test",type="univariate",
                   template=shapiro.test(rnorm(100)),
                   container = container)
}

gui.var.test = function(container=NULL) {
  gui.htest("var.test",type="bivariate",
                   template=var.test(rnorm(100), rnorm(100)),
                   container = container)
}

gui.prop.test = function(container=NULL) {
  gui.htest("prop.test", type="x.and.n",
                   template = prop.test(10,20,p=.5),
                   container=container)
}

gui.prop.test.2sample = function(container=NULL) {
  gui.htest("prop.test", type="x.and.n.2",
                   template = prop.test(c(10,20),c(20,30)),
                   container=container)
}

gui.binom.test  = function(container=NULL) {
  gui.htest("binom.test", type="x.and.n",
                   template = binom.test(10,20,p=.5),
                   container=container)
}

gui.binom.test.2sample = function(container=NULL) {
  gui.htest("binom.test", type="x.and.n.2",
                   template = binom.test(c(10,20),c(20,30)),
                   container=container)
}



##################################################
### Thre functions:
## * one to draw template
## * one to initialize
## * one to update on events

## sequence:
## * define template x
## * pass to HtestTemplate
## * this returns widgets. Populate widgets with defaults
## * on actinos, update widgets


### workhorse
gui.htest = function(
  FUN = "t.test",
  type = c("univariate","bivariate","x.and.n","x.and.n.2","x~f"),
  template = do.call(FUN,list(x=rnorm(100))),
  extra.args = NULL,                    # eg list("var.equal"=TRUE)
  container = NULL,
  ...) {

  type = match.arg(type)

  ##
  x = template
  obj = dHtest(x, type)
##  tag(obj,  "dropHandlers")  <- list()

  passiveComponents = tag(obj,"passiveComponents")
  
  if(!is.null(container))
    add(container,obj, expand=TRUE)

  ## now initialize
  initialize = function(obj, ...) {
    object.list = tag(obj,"object.list")
    if(!type %in% c("x.and.n","x.and.n.2")) {
      svalue(object.list[['data.name']]) <-  "Drop variable(s) here"
    }
    svalue(object.list[["null.value"]]) <-  x$null.value
    svalue(object.list[["alternative"]]) <-  "not equal to"
    svalue(object.list[["statistic.name"]]) <- names(x$statistic)
    svalue(object.list[["parameter.name"]]) <- names(x$parameter)
    svalue(object.list[["null.value.name"]]) <- names(x$null.value)
    ## confidence interval value
    x$conf.int.name = attr(x$conf.int,"conf.level")
    svalue(object.list[["conf.int.name"]]) <-  x$conf.int.name*100
     for(i in passiveComponents)
      object.list[[i]] = glabel("*")
  }

  initialize(obj)

  object.list = tag(obj,"object.list")
  ## add handlers
  if(!type %in% c("x.and.n","x.and.n.2")) {
    adddroptarget(object.list[['data.name']],
                  handler=function(h, ...) {
                    varList = tag(h$obj,"varList")
                    if(!is.list(varList)) 
                      varList = list()
                    n = length(varList)
                    varList[[n+1]] = h$dropdata
                    theName = id(h$dropdata)

                    svalue(object.list[['data.name']]) <-  theName
                    ## do I append here?
                    tag(object.list[['data.name']], "varList") <- varList
                    updatedHtest(obj)
                    ## add handler for drop data
                    ## now bind to be dynamic *if* a treeviewcolumn
                    ## NEED to make thin in gWidgets,
                    if(is.gdataframecolumn(h$dropdata)) {
                      addhandlerchanged(h$dropdata,
                                        handler=function(h,...) updatedHtest(obj)
                                        )
                    }
                  })
    addhandlerchanged(object.list[['data.name']],
                    action = obj,
                    handler=function(h,...) {
                        varList = tag(object.list[['data.name']],"varList")
                        if(!is.list(varList)) 
                          varList = list()
                        n = length(varList)
                        string = svalue(h$obj)
                        ## split on " and "
                        tmp = unlist(strsplit(string," and "))
                        for(i in 1:length(tmp)) {
                          tmp[i] = stripWhiteSpace(tmp[i])
                          if(length(grep("dropvariable",tolower(tmp[i])))==0)
                            varList[[n+i]] = tmp[i]
                        }
                        tag(object.list[['data.name']], "varList") <- varList
                        svalue(object.list[['data.name']]) <- paste(unlist(varList),sep=" and ")
                        updatedHtest(obj)
                      })
  }
  addhandlerchanged(object.list[['null.value']],
                    action = obj,
                    handler = function(h,...) {
                      updatedHtest(h$action)
                    })

  addhandlerchanged(object.list[['alternative']],
                    action = obj,
                    handler = function(h,...) {
                      updatedHtest(h$action)
                    })
  addhandlerchanged(object.list[['conf.int.name']],
                    action = obj,
                    handler = function(h,...) {
                      updatedHtest(h$action)
                    })

                       tag(obj,"FUN") <- FUN
                       tag(obj,"extra.args") <- extra.args
                       tag(obj,"type") <- type

  return(obj)
}


## This is main function
## call function, update widgets
updatedHtest = function(object, ...) {
  obj = object                          # for s3 consistency

  FUN = tag(obj,"FUN")
  extra.args = tag(obj,"extra.args")
  TYPE = tag(obj,"type")
  object.list = tag(obj,"object.list")
  dataVarList = tag(object.list[["data.name"]], "varList")
  x = list()

  h0 = as.numeric(svalue(object.list[["null.value"]]))
  hA = svalue(object.list[["alternative"]])
  if(is.empty(hA))
    hA = "not equal to"
  hA = switch(hA,                     # translate
    "not equal to" = "two.sided",
    "less than" = "less",
    "greater than" = "greater")
  conf.int.name = as.numeric(svalue(object.list[["conf.int.name"]]))/100
  
  
  ## one sample guys
  if(TYPE == "univariate") {

    ## t.test one sample
    n = length(dataVarList)
    theName = id(dataVarList[[n]])
    theValues = svalue(dataVarList[[n]])
    if(length(theValues) <= 1) {
      return()
    }

    theArgs = list(x = theValues, mu=h0, alternative=hA,
      conf.level=conf.int.name)
    x = try(do.call(FUN,c(theArgs,extra.args)), silent=TRUE)
    if(inherits(x,"try-error")) {
      cat("Error with function call:",x,"\n")
    }
    x$data.name = theName             # override
  } else if (TYPE == "bivariate") {
    ## two sample guy
    n = length(dataVarList)
    if(n == 0) {
      cat("Drop some variables\n")
      return()
    } else if(n == 1) {
      ## need another
      cat("Need another\n")
      x$data.name = Paste(id(dataVarList[[1]])," and Drop variable here")
#      tmp = Paste(id(dataVarList[[1]])," and Drop variable here")
#      svalue(object.list[["data.name"]]) <- format(tmp)
    } else  {                           # n > 1
      theXName = id(dataVarList[[n-1]])
      theXValues = svalue(dataVarList[[n-1]])
      theYName = id(dataVarList[[n]])
      theYValues = svalue(dataVarList[[n]])
      if(length(theXValues) <= 1 || length(theYValues) <= 1) {
        return()
      }

      theArgs = list(x = theXValues, y= theYValues,
        mu=h0, alternative=hA,
        conf.level=conf.int.name)

      x = try(do.call(FUN,c(theArgs, extra.args)), silent=TRUE)
      if(inherits(x,"try-error")) {
        cat("Error with function call:",x,"\n")
      }
      x$data.name = Paste(id(dataVarList[[n-1]])," and ",
        id(dataVarList[[n]]))
    }

    } else if (TYPE == "x.and.n") {
    dataVals = object.list[["data.name"]][,,drop=FALSE]
    if(length(dataVals) >=2) {
      theArgs = list(
        x = as.numeric(dataVals$x), n= as.numeric(dataVals$n),
        p=h0, alternative=hA,
        conf.level=conf.int.name)
      x = try(do.call(FUN,c(theArgs,extra.args)), silent=TRUE)
    } else {
      return()
    }
  } else if (TYPE == "x.and.n.2") {
    dataVals = object.list[["data.name"]][,,drop=FALSE] # as matrix
    if(nrow(dataVals) !=2 || ncol(dataVals) !=2 || any(is.na(dataVals))) {
      return()
    } else {
      theArgs = list(
        x = as.numeric(dataVals[,1,drop=TRUE]),
        n = as.numeric(dataVals[,2,drop=TRUE]),
        alternative=hA,
        conf.level=conf.int.name)
      x = try(do.call(FUN,c(theArgs,extra.args)), silent=TRUE)
    }
  } else if(TYPE == "x~f") {

    ## find out which is a factor, which is numeric
    ## Need two variables
    n = length(dataVarList)
    if(n == 0) {
      cat("Drop two variables. One should be a factor.\n")
      return()
    } 

    ## check for handtyped formulas in the dataVarList
    if(n >= 1) {
      typedIn = ""
      if(n >= 2) {                    # try n-1
        if(is.character(dataVarList[[n-1]]) &&
           length(grep(pattern="~",dataVarList[[n-1]]))) {
          typedIn = dataVarList[[n-1]]
        }
      } ## try n now
      if(is.character(dataVarList[[n]]) &&
         length(grep(pattern="~",dataVarList[[n]]))) {
        typedIn = dataVarList[[n]]
      }
      
      ## if typeIn then handle separately
      if(typedIn != "") {
        form = eval(parse(text=typedIn))
        tmp = all.vars(form)
        form = svalue(tmp[1]) ~ svalue(tmp[2])
        x = try(do.call(FUN,list(form)), silent=TRUE)
        if(inherits(x,"try-error")) {
          ## What to do with an error:
          cat("Error with function call:",x,"\n")
        } 
        x$data.name = Paste(tmp[1], " ~ ", tmp[2])
      } else if(n == 1) {
        tmp = Paste(id(dataVarList[[1]])," and drop variable here")
        svalue(object.list[["data.name"]]) <-  format(tmp)
        x = NULL
      } else  {                           # n > 1
        theXName = id(dataVarList[[n-1]])
        theXValues = svalue(dataVarList[[n-1]])
        theYName = id(dataVarList[[n]])
        theYValues = svalue(dataVarList[[n]])
        if(length(theXValues) <= 1 || length(theYValues) <= 1) {
          return()
        }
        
        argList = list()
        theName = ""
        ## find out which is a factor
        if(is.factor(theXValues) && is.factor(theYValues)) {
          theName = "Two factors, need one numeric variable, and one factor"
        } else if (is.factor(theXValues) && is.numeric(theYValues)) {
          argList[['formula']] = theYValues ~ theXValues
          theName = Paste(theYName, " ~ ", theXName)
        } else if (is.numeric(theXValues) && is.factor(theYValues)) {
          argList[['formula']] = theXValues ~ theYValues
          theName = Paste(theXName, " ~ ", theYName)
        } else if (is.numeric(theXValues) && is.numeric(theYValues)) {
          cat("Coercing",theYName,"to be a factor\n")
          argList[['formula']] = theXValues ~ as.factor(theYValues)
          theName = Paste(theXName, " ~ as.factor(", theYName,")")
        } else  {
          theName = "Need one numeric variable and one factor"
        }

        ## don't do this *if* FUN=...
        ## these funs don't take alter or conf.level
        if(FUN %in% c("oneway.test","kruskal.test")) {
          argList$alternative = NULL
          argList$conf.level = NULL
        } else {
          argList$alternative = hA
          argList$conf.level=conf.int.name
        }          

        
        x = try(do.call(FUN,c(argList, extra.args)), silent=TRUE)
        if(inherits(x,"try-error")) {
          ## What to do with an error:
          cat("Error with function call:",x,"\n")
        } 

        x$data.name = theName

      }
    }

  }

  if(is.null(x) || inherits(x,"try-error"))
    return()
  
#    x$statistic.name = names(x$statistic)
#    x$parameter.name = names(x$parameter)
    x$conf.int.name = attr(x$conf.int,"conf.level")
#    x$null.value.name = names(x$null.value)

    plainVals = c(
      "statistic",   
      "parameter",   
      "conf.int",
      "p.value",
      "method",    "estimate"
      )
    for(i in plainVals) {
      svalue(object.list[[i]]) <-  format(x[[i]])
    }
  if(! TYPE %in% c("x.and.n","x.and.n.2"))
    svalue(object.list[["data.name"]]) <- x$data.name

  svalue(object.list[["conf.int"]]) <- 
    Paste("(", format(x$conf.int[1]),",  ",format(x$conf.int[2]),")")
  
  svalue(object.list[["estimate"]]) <- 
    paste(names(x$estimate), format(x$estimate), sep=" = ", collapse=", ")
}

##################################################
##
##
dHtest = function(x, type=NULL, digits = 4, container = NULL, ...) {
  ## x is passed in via ...
  ## this function sets up the widgets and returns the widdgets in an object

  ## "data.name"  
  ## "statistic"   "statistic.name"
  ##" parameter"   "paramter.name"
  ## "null.value"  "null.value.name" "alternative" "method"     
  ## "p.value"     "conf.int"   
  ## "estimate"

  activeComponents = c(
    "data.name"  ,                      # data
    "null.value",                       # H_0
    "alternative",                      # H_A
    "conf.int.name")                         # alpha

  passiveComponents = c(
    "statistic",   "statistic.name",
    "parameter",   "parameter.name",
    "conf.int",
    "null.value.name",
    "p.value",
    "method",    "estimate"
    )

  group = ggroup(horizontal=FALSE, container = container)
#  obj = list(ref=group)
#  class(obj) <- c("dHtest", "gComponent", "gWidget")

  obj = group                           # avoid S3 extension
  
  tag(obj, "activeComponents") <- activeComponents
  tag(obj, "passiveComponents") <- passiveComponents
  
  object.list = list()
  for(i in passiveComponents) {
    object.list[[i]] = glabel("*")
    font(object.list[[i]]) <- c(color="red")
  }
  for(i in activeComponents) {
    object.list[[i]] = glabel("*", editable=TRUE)
    font(object.list[[i]]) <-  c(style="bold")
  }

  ## override
#  object.list[['null.value']] = gedit("")
#  object.list[['data.name']] = gbutton("Drop variables here")

  altVals = c("not equal to","less than","greater than")
  object.list[['alternative']] = gdroplist(altVals,selected=1)

#  object.list[['conf.int.name']] = gdroplist(c("80","95","99"), selected=2, editable=TRUE)

  ## data for prop,.test
  if(type == "x.and.n" || type == "x.and.n.2") {
    aDF = data.frame(x=I(c("","")),n = I(c("","")))
    rownames(aDF) = c("sample 1","sample 2")
    if(type == "x.and.n")
      aDF=aDF[1,]
    object.list[["data.name"]] = gdf(aDF)
    addhandlerchanged(object.list[["data.name"]],handler=function(h,...) {
      updatedHtest(obj)
    })
  }
    
  
  ## setup window
#  text = gtext(container=container)
  tag(obj, "object.list") <- object.list
  
#  add(text,"")
#  add(text,x$method, font.attr=c("bold","large"))

  add(group, glabel(Paste("<b><i>",x$method,"</i></b>"), markup=TRUE))

  newLine = ggroup(container=group)
  add(newLine,glabel("data: "))
  add(newLine,object.list[["data.name"]], expand=TRUE) # need expand=TRUE for some widgets
  
  if(!is.null(x$statistic)) {
    newLine = ggroup(container=group)
    add(newLine, object.list[["statistic.name"]])
    add(newLine,glabel(" = "))
    add(newLine, object.list[["statistic"]])
  }

  if(!is.null(x$parameter)) {
    newLine = ggroup(container=group)
    add(newLine,object.list[["parameter.name"]])
    add(newLine,glabel(" = "))
    add(newLine, object.list[["parameter"]])
  }
  if(!is.null(x$p.value)) {
    newLine = ggroup(container=group)
    fp <- format.pval(x$p.value, digits = digits)
    inequality = if(substr(fp,1,1) == "<") "" else " = "
    add(newLine, glabel(Paste("p-value ", inequality)))
    add(newLine, object.list[["p.value"]])
  }

  if(!is.null(x$alternative)) {
    newLine = ggroup(container=group)
    add(newLine,glabel("alternative hypothesis: "))
    newLine = ggroup(container=group)
    add(newLine,glabel("   "))          # format
    if(!is.null(x$null.value)) {
      if(length(x$null.value) == 1) {
        alt.char <-
          switch(x$alternative,
                 two.sided = " not equal to ",
                 less = " less than ",
                 greater = " greater than ")
        add(newLine, glabel("true "))
        add(newLine, object.list[["null.value.name"]])
        add(newLine, glabel(" is "))
        
        add(newLine, object.list[["alternative"]])
        add(newLine, object.list[["null.value"]])
      } else {
        add(newLine, glabel(Paste(x$alternative, "\nnull values:\n")))
        add(newLine, glabel(paste(x$null.value,collapse="\t")))
      }
    } else {
      add(newLine, object.list[["alternative"]])
    }
  }

  if(!is.null(x$conf.int)) {
    newLine = ggroup(container=group)
    add(newLine,object.list[["conf.int.name"]])
    add(newLine,glabel(" percent confidence interval:"))
    newLine = ggroup(container=group)
    add(newLine,glabel("    "))         # space
    add(newLine,object.list[["conf.int"]])
  }
  if(!is.null(x$estimate)) {
    newLine = ggroup(container=group)
    add(newLine,glabel("sample estimates:"))
    newLine = ggroup(container=group)
    add(newLine,glabel("    "))         # space
    add(newLine, object.list[["estimate"]])
  }

  
  return(obj)
  
}

getGTKwidget.dHtest = function(obj, ...) obj$ref$ref


## dHtest = function(x, digits = 4, container = NULL, ...) {
##   ## x is passed in via ...
##   ## this function sets up the widgets and returns the widdgets in an object

##   ## "data.name"  
##   ## "statistic"   "statistic.name"
##   ##" parameter"   "paramter.name"
##   ## "null.value"  "null.value.name" "alternative" "method"     
##   ## "p.value"     "conf.int"   
##   ## "estimate"

##   activeComponents = c(
##     "data.name"  ,                      # data
##     "null.value",                       # H_0
##     "alternative",                      # H_A
##     "conf.int.name")                         # alpha

##   passiveComponents = c(
##     "statistic",   "statistic.name",
##     "parameter",   "parameter.name",
##     "conf.int",
##     "null.value.name",
##     "p.value",
##     "method",    "estimate"
##     )

##   object.list = list()
##   for(i in passiveComponents)
##     object.list[[i]] = glabel("*")
##   for(i in activeComponents)
##     object.list[[i]] = gbutton("")

##   ## override
##   object.list[['null.value']] = gedit("")
##   object.list[['alternative']] = gdroplist(c("two.sided","less","greater"),
##                selected=1)
##   object.list[['conf.int.name']] = gdroplist(c("80","95","99"), selected=2, editable=TRUE)
               


  
##   ## setup window
##   text = gtext(container=container)
##   obj = list(ref=text)
##   .class(obj) <- c("dHtest", "gComponent", "gWidget")
##           tag(obj, "object.list") <- object.list
  
##   add(text,"")
##   add(text,x$method, font.attr=c("bold","large"))

##   add(text,"data: ",do.newline=FALSE)
## #  add(text,x$data.name, font.attr=c("red"))
##   add(text,object.list[["data.name"]])
##   add(text, "")
  
##   if(!is.null(x$statistic)) {
##     add(text, object.list[["statistic.name"]], do.newline=FALSE)
##     add(text," = ", do.newline=FALSE)
##     add(text, object.list[["statistic"]])
##     add(text, "")
##   }

##   if(!is.null(x$parameter)) {
##     add(text,object.list[["parameter.name"]], do.newline=FALSE)
##     add(text," = ", do.newline=FALSE)
##     add(text, object.list[["parameter"]])
##     add(text, "")
##   }
##   if(!is.null(x$p.value)) {
##     fp <- format.pval(x$p.value, digits = digits)
##     inequality = if(substr(fp,1,1) == "<") "" else " = "
##     add(text, Paste("p-value ", inequality), do.newline=FALSE)
##     add(text, object.list[["p.value"]])
##     add(text, "")
##   }

##   if(!is.null(x$alternative)) {
##     add(text,"alternative hypothesis: ")
##     if(!is.null(x$null.value)) {
##       if(length(x$null.value) == 1) {
##         alt.char <-
##           switch(x$alternative,
##                  two.sided = " not equal to ",
##                  less = " less than ",
##                  greater = " greater than ")
##         add(text, "true ", do.newline=FALSE)
##         add(text, object.list[["null.value.name"]],  do.newline=FALSE)
##         add(text, " is ",  do.newline=FALSE)
        
##         add(text, object.list[["alternative"]], do.newline=FALSE)

##         add(text, "   ", do.newline=FALSE) # breathe

##         add(text, object.list[["null.value"]])
##       } else {
##         add(text, Paste(x$alternative, "\nnull values:\n"))
##         add(text, paste(x$null.value,collapse="\t"))
##       }
##     } else {
##       add(text, object.list[["alternative"]])
##     }
##     add(text, "")
##   }

## if(!is.null(x$conf.int)) {
    
##     add(text,
##         object.list[["conf.int.name"]],
##         do.newline=FALSE)
##     add(text," percent confidence interval:")
##     add(text,object.list[["conf.int"]])
##     add(text, "")
##   }
##   if(!is.null(x$estimate)) {
##     add(text,"sample estimates:")
##     add(text, object.list[["estimate"]])
##   }

  
##   return(obj)
  
## }


## print.htest <- function(x, digits = 4, quote = TRUE, prefix = "", ...)
## {
##     cat("\n")
##     writeLines(strwrap(x$method, prefix = "\t"))
##     cat("\n")
##     cat("data: ", x$data.name, "\n")
##     out <- character()
##     if(!is.null(x$statistic))
## 	out <- c(out, paste(names(x$statistic), "=",
## 			    format(round(x$statistic, 4))))
##     if(!is.null(x$parameter))
## 	out <- c(out, paste(names(x$parameter), "=",
## 			    format(round(x$parameter, 3))))
##     if(!is.null(x$p.value)) {
## 	fp <- format.pval(x$p.value, digits = digits)
## 	out <- c(out, paste("p-value",
## 			    if(substr(fp,1,1) == "<") fp else paste("=",fp)))
##     }
##     writeLines(strwrap(paste(out, collapse = ", ")))
##     if(!is.null(x$alternative)) {
## 	cat("alternative hypothesis: ")
## 	if(!is.null(x$null.value)) {
## 	    if(length(x$null.value) == 1) {
## 		alt.char <-
## 		    switch(x$alternative,
## 			   two.sided = "not equal to",
## 			   less = "less than",
## 			   greater = "greater than")
## 		cat("true", names(x$null.value), "is", alt.char,
## 		    x$null.value, "\n")
## 	    }
## 	    else {
## 		cat(x$alternative, "\nnull values:\n")
## 		print(x$null.value, ...)
## 	    }
## 	}
## 	else cat(x$alternative, "\n")
##     }
##     if(!is.null(x$conf.int)) {
## 	cat(format(100 * attr(x$conf.int, "conf.level")),
## 	    "percent confidence interval:\n",
## 	    format(c(x$conf.int[1], x$conf.int[2])), "\n")
##     }
##     if(!is.null(x$estimate)) {
## 	cat("sample estimates:\n")
## 	print(x$estimate, ...)
##     }
##     cat("\n")
##     invisible(x)
## }
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/dLatticeExplorer.R"
## create a droppable, dyamic widget for exploratory graphs
## aspect: fill, xy, iso
## type: 
## TODO: make panel functions better
##       * add more lattice graphs?
##       * means to edit formulas
## when we close window -- clear out handlers on clear button
## add refressh button or refresh on click?
## for drawing panel on graphs
panel.mean = function(x,y) {
  panel.abline(v=mean(x))
}
panel.median = function(x,y) {
  panel.abline(v=median(x))
}

dLatticeExplorer = function(
  container = NULL,
  ...) {
  
  ## graphics device
  gdGroup = ggroup(horizontal=FALSE, container = container, raise.on.dragmotion = TRUE)
  gd = ggraphics()

  
#  obj = list(ref=gdGroup, device = gd)
#  class(obj) = c("dLatticeExplorer","gComponent","gWidget")

  obj = gdGroup

  
  ## initialize
  tag(obj,"varlist") <- list()
  tag(obj,"function") <- "densityplot"
  tag(obj, "dropHandlers") <- list()
  
  ## add buttons
  gdButtons = ggroup(container = gdGroup)
  add(gdGroup, gd, expand=FALSE)
  f = gframe("lattice options", container = gdGroup)
  latticeOptionsGroup = ggroup(horizontal=TRUE, container = f, expand=TRUE)

  
  ## what to do with dropped values.
  ## can't put obj in here without some machinations, as the
  dropHandler = handler = function(h,...) {
    ## we have the following:
    ## add to varlist by appending
    ## obj is found by closure
    varlist = tag(obj,"varlist")
    tag(obj,"varlist") <- c(varlist, h$dropdata)
    updatedLatticeExplorer(obj)

    ## now bind to be dynamic *if* a treeviewcolumn
#    if(class(h$dropdata)[1] == "GtkTreeViewColumn") {
    if(is.gdataframecolumn(h$dropdata)) {
      view.col = h$dropdata
      id = addhandlerchanged(view.col, handler=function(h,...) updatedLatticeExplorer(obj))
      dropHandlers = tag(obj,"dropHandlers")
      dropHandlers[[length(dropHandlers)+1]] = list(
                    view.col = view.col,
                    id = id
                    )
      tag(obj,"dropHandlers") <- dropHandlers
     }
    return(TRUE)
  }
  adddroptarget(gd,targetType="object",handler = dropHandler )

   allGraphs = c("histogram","densityplot","qqmath",
     "--------",
     "dotplot","xyplot","barchart","stripplot","bwplot","qq")
  univariateGraphs = c("histogram","densityplot","qqmath")
  bivariateGraphs = c("xyplot","qq")
   availPanelFuns = list(
     dotplot = c("mean","median"),
     xyplot = c("lmline","loess","lines","rug"),
     barchart = c(),
     stripplot = c("mean","median"),
     bwplot = c("violin","mean"),
     qq = c("lmline"),
     "--------" = c(),
     histogram = c(),
     densityplot = c("rug","mean","median"),
     qqmath = c("qqmathline")
     )
  ## now store these into the object
  tag(obj,"allGraphs")  <- allGraphs
  tag(obj,"univariateGraphs")  <- univariateGraphs
  tag(obj,"bivariateGraphs")  <- bivariateGraphs
  tag(obj,"availPanelFuns")  <- availPanelFuns

  clearButton = gbutton("clear",action = obj,
    handler = function(h,...) {
      clearPlot(obj)
      svalue(plotChooser) <- "densityplot"
    })
  add(gdButtons,clearButton)
  add(gdButtons,gbutton("refresh",handler = function(h,...) {
    updatedLatticeExplorer(obj)
  }))
  addSpring(gdButtons)

  plotChooser = gdroplist(c(allGraphs), container=gdButtons,
    action = obj,
    handler = function(h,...) {
      FUN = svalue(h$obj)
      if(!is.empty(FUN) || FUN != "--------") {
        tag(h$action,"function") <- FUN
        clearPanel(obj)
        updatePanel(obj)
        updatedLatticeExplorer(obj)
      }
    })
  svalue(plotChooser) <- "densityplot"

  PanelChooser = gdroplist(c("panel="), container = gdButtons,
     action = obj,
     handler = function(h,...) {
       panel.FUN = svalue(h$obj)
       if(!is.empty(panel.FUN) && panel.FUN != "panel=")
         tag(obj, "panel") <- panel.FUN
       else
         tag(obj, "panel") <- NA
       updatedLatticeExplorer(obj)
     })
  tag(obj,"plotChooser") <-  plotChooser
  tag(obj,"PanelChooser") <-  PanelChooser


  glabel("aspect=", cont=latticeOptionsGroup)
  aspectChooser = gdroplist(c("fill","xy","iso"), editable=TRUE,
    cont=latticeOptionsGroup,
    handler = function(...) updatedLatticeExplorer(obj))

  gseparator(horizontal=FALSE,cont=latticeOptionsGroup)
  glabel("type=", cont=latticeOptionsGroup)
  typeChooser = gcheckboxgroup(c('p','l','a','o'),
    horizontal=TRUE,
    cont=latticeOptionsGroup,
    handler = function(...) updatedLatticeExplorer(obj))

  gseparator(horizontal=FALSE,cont=latticeOptionsGroup)
  glabel("col=",cont=latticeOptionsGroup)
  colChooser = gdroplist(c("","black","red","blue","green","brown","yellow"),
    cont = latticeOptionsGroup,
    handler = function(...) updatedLatticeExplorer(obj))

  tag(obj,"aspectChooser") <- aspectChooser
  tag(obj,"typeChooser") <- typeChooser
  tag(obj,"colChooser") <- colChooser

  updatePanel(obj)

#  makeEmptyPlot(obj)

  ## clean up when closed or unrealized
  addhandlerunrealize(obj, handler = function(h,...) {
    clearPlot(obj)                      # also clears out handlers
  })
  return(obj)
}
##################################################
## evaluate plot
as.dLatticeExplorer = function(da,...) {
  warning("as.dLatticeExplorer Needs writing")
  return(da)
  if(class(da)[1] == "GtkDrawingArea" &&
     !is.empty(tag(da,"device"))) {
    da = list(ref=da, device = tag(da,"device"))
    class(da) <- c("iGD", "iComponent")
  }
  if(class(da)[1] == "iGd") {
    obj = list(ref=NULL, device=da)
    class(obj) = c("dLatticeExplorer","gComponent","gWidget")
    return(obj)
  } else {
    return(da)
  }
}

##getGTKwidget.dLatticeExplorer = function(obj,...) obj$ref ##obj$device$ref #$ref??
##visible.dLatticeExplorer = function(obj,...) visible(obj$device)

## Main workhorse
updatedLatticeExplorer = function(object,...) {
  obj = object                          # for s3 consistency
  require(lattice)

  
  vars = tag(obj,"varlist")
  FUN = tag(obj,"function")
  doUnivariate = FUN %in% tag(obj,"univariateGraphs")
  doBivariate = FUN %in% tag(obj,"bivariateGraphs")
  
  ## make formula
  nvars = length(vars)
  ## where to evaluate
  env = environment()
    
  if(nvars == 0) {
    cat("can't draw plot, add variables\n")
    makeEmptyPlot(obj)                  # default message
    return()
  }

  ## assign values within env for eval parse
  varNames = sapply(1:nvars, function(i) id(vars[[i]]))
  sapply(1:nvars, function(i)
         assign(id(vars[[i]]),svalue(vars[[i]]), envir=env)
         )

  command = NA
  lst = list()
  if(nvars == 1) {
    if(doBivariate) {
      makeEmptyPlot(obj,"Needs atleast one more variable")
      return()
    }
    if(doUnivariate) {
      command = Paste(FUN,"( ~ ", varNames[1],")")
      xlab = varNames[1]; ylab=NULL
      x = ~ svalue(vars[[1]])
    } else {
      command = Paste(FUN,"(", varNames[1],")")
      xlab = varNames[1]; ylab=NULL
      x = svalue(vars[[1]])
    }
  }

  if(nvars == 2) {
    ## check that not too many levels
    if(!doBivariate) {
      if(nlevels(shingle(svalue(vars[[2]]))) > 40) {
        cat("Too many levels for the conditioning variable\n")
        makeEmptyPlot(obj,"Too many levels for conditioning\nvariable. Try a biviate plot?")
        return()
      }
    }
    if(doUnivariate) {
      command = Paste(FUN,"( ~ ", varNames[1],"|", varNames[2],")")
      xlab = varNames[1]; ylab = NULL
      x = ~ svalue(vars[[1]]) | svalue(vars[[2]])
    } else {
      command = Paste(FUN,"(", varNames[1],"~", varNames[2],")")
      xlab = varNames[2]; ylab = varNames[1]
      x = svalue(vars[[1]]) ~ svalue(vars[[2]])
    }
  }

  if(nvars >= 3) {
    if(doUnivariate) {
      command = Paste(FUN,"( ~ ", varNames[1],"|", varNames[2],")")
      xlab = varNames[1]; ylab = NULL
      x = ~ svalue(vars[[1]]) | svalue(vars[[2]])
      cat("Too many values for univariate graph. Clear and do again.")
    } else {
      if(doBivariate) {
        m2 = nlevels(shingle(svalue(vars[[3]])))
        if(m2 > 25) {
          cat("Too many levels for the conditioning variables\n")
          makeEmptyPlot(obj,"Too many levels for conditioning\nvariable.")
          return()
        }
      } else {
        m1 = nlevels(shingle(svalue(vars[[2]])))
        m2 = nlevels(shingle(svalue(vars[[3]])))
        if(m1*m2 > 40) {
          cat("Too many levels for the conditioning variables\n")
          makeEmptyPlot(obj,"Too many levels for conditioning\nvariables.")
          return()
        }
      }
      
      

      command = Paste(FUN,"(", varNames[1],"~", varNames[2],"|", varNames[3],")")
      xlab = varNames[1]; ylab = varNames[2]
      x = svalue(vars[[2]]) ~ svalue(vars[[1]]) | svalue(vars[[3]])
    }
  }
  
  lst$x = x
  lst$main = command
  lst$xlab = xlab
  lst$ylab = ylab
  ## add panel
  panel.FUN = tag(obj,"panel")
  if(is(panel.FUN,"guiWidget")) panel.FUN = svalue(panel.FUN)
  if(!is.empty(panel.FUN) && panel.FUN != "panel=") {
    lst$panel = function(x,y,...) {
      arglist = list()
      if(missing(x)) {
        return()
      } else if(missing(y)) {
        arglist$x = x
      } else {
        arglist$x = x; arglist$y = y
      }
      if(panel.FUN != "panel=" && is.character(panel.FUN)) {
        do.call(Paste("panel.",FUN),arglist)
        do.call(Paste("panel.",panel.FUN),arglist)
      }
    }
  } else {
    lst$panel = NULL
  }

  ## aspect
  aspectVal <- svalue(tag(obj,"aspectChooser"))
  lst$aspect = aspectVal
  ## type
  typeVals <- svalue(tag(obj,"typeChooser"))
  if(length(typeVals) > 0)
    lst$type = typeVals
  ## color
  colVal <- svalue(tag(obj,"colChooser"))
  if(colVal != "")
    lst$col = colVal

  ## plot
  if(!is.null(lst$x)) {
    x = try(do.call(FUN, lst), silent=TRUE)
    if(!inherits(x,"try-error"))
      print(x)            # don't forget print()
    else
      cat("Not ready to plot:",x,"\n")
  }     
}


updateLatticeOptions = function(obj) {
  svalue(tag(obj,"aspectChooser")) <- 1
  svalue(tag(obj,"typeChooser")) <- c()
  svalue(tag(obj,"colChooser"), index=TRUE) <- 1
}

clearPlot = function(obj) {
  tag(obj,"varlist") <- list()
  dropHandlers = tag(obj,"dropHandlers")
  if(length(dropHandlers) > 0) {
    for(i in 1:length(dropHandlers)) {
      removehandler(dropHandlers[[i]]$view.col,dropHandlers[[i]]$id)
    }
    tag(obj,"dropHandlers") <- list()
  }
  updatePanel(obj)
  updateLatticeOptions(obj)
  PanelChooser = tag(obj,"PanelChooser"); svalue(PanelChooser, index=TRUE)<-1  
  updatedLatticeExplorer(obj)
}

makeEmptyPlot = function(obj, message="Drop variable(s) here") {
#  visible(obj) <- TRUE
  x = try(plot.new(), silent=TRUE)
  if(!inherits(x,"try-error")) {
    plot.window(xlim=c(0,1),ylim=c(0,1))
    text(1/2, 1/2, message)
  }
}

clearPanel = function(obj) {
  PanelChooser = tag(obj,"PanelChooser") # keep in object
  if(!is.null(PanelChooser)) {
    PanelChooser[]<- c("panel=")
    tag(obj,"panel") <-  NA
  }
}

## available panel functions depends on graph
updatePanel = function(obj) {
  FUN = tag(obj,"function")
  funs = tag(obj,"availPanelFuns")[[FUN]]
  PanelChooser = tag(obj,"PanelChooser") # kept in object
  if(!is.null(funs))
    PanelChooser[] <- c("panel=",funs)
  else
    PanelChooser[] <- c("panel=")
}



### testing -- delete me
##gp = ggroup(container=gwindow(v=T))
##add(gp, (vb <- gvarbrowser()))
##add(gp, (adf <- ieditdataframe(mtcars, filter.column=3)),expand=TRUE)
##add(gp, (ile <- ilatticeexplorer()))
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/dModelsDialog.R"
## Simple Dynamic Models dialog
## output has regular model methods defined for it except update()
dModelsDialog = function() {
  ## list of avail. models
  models = list(
    "linear regression"= "gui.lm",
    "robust regresion" = "gui.rlm",
    "-----" = "-----",
    "Analysis of variance"="gui.aov"
    )

  ## main groups
  win = pmgWC$new("Models",v=T)
  gp = ggroup(horizontal=FALSE, container=win, raise.on.dragmotion = TRUE)
  popupGroup = ggroup(container=gp)
  addSpring(popupGroup)
  testPopup = gdroplist(c("",names(models)), container=popupGroup)
  gseparator(container=gp)
  testWindow = ggroup(container=gp)

  obj = list(ref=testWindow)
  class(obj) = c("gDynamicModelDialog")
  
  dialogList = list()
  dialogList[["FirstOne"]] = glabel("Select a model from popup")
  
  add(testWindow,dialogList[["FirstOne"]], expand=TRUE)
  tag(testWindow, "dialogList") <- dialogList
  tag(testWindow,"currentTest") <- dialogList[["FirstOne"]]
  
  addhandlerchanged(testPopup, handler = function(h,...) {
    popupValue = svalue(testPopup)
    if(!is.empty(popupValue) || popupValue != "-----") {
      delete(testWindow,tag(testWindow,"currentTest"))
      dialogList = tag(testWindow, "dialogList")
      if(is.null(dialogList[[popupValue]])) {
        dialogList[[popupValue]] <- do.call(models[[popupValue]],list())
        tag(testWindow, "dialogList") <-  dialogList
      }
      add(testWindow,dialogList[[popupValue]]$ref, expand=TRUE)
      tag(testWindow,"currentTest") <- dialogList[[popupValue]]$ref
  }
  })

  ## tidy up on uneralize. Need to get afresh
  addhandlerdestroy(win, handler = function(h,...) {
    for(i in dialogList) {
      dropHandlers = tag(i,"dropHandlers")
      if(length(dropHandlers) > 0) {
        for(i in 1:length(dropHandlers)) {
          removehandler(dropHandlers[[i]]$view.col,dropHandlers[[i]]$id)
        }
      }
    }
  })

  return(obj)
}


## The regular R model methods
summary.gDynamicModelDialog = function(object, ...)
  summary(tag(object$ref,"currentTest"), ...)
anova.gDynamicModelDialog = function(object, ...)
  anova(tag(object$ref,"currentTest"), ...)
coefficients.gDynamicModelDialog = function(object,...)
  coefficients(tag(object$ref,"currentTest"), ...)
effects.gDynamicModelDialog  = function(object,...)
  effects(tag(object$ref,"currentTest"), ...)
fitted.values.gDynamicModelDialog = function(object,...)
  fitted.values(tag(object$ref,"currentTest"), ...)
residuals.gDynamicModelDialog = function(object, ...) 
  residuals(tag(object$ref,"currentTest"),  ...)
predict.gDynamicModelDialog = function(object, ...) 
  predict(tag(object$ref,"currentTest"),  ...)
plot.gDynamicModelDialog = function(x, ...)  {
  print(list(...))
  plot(tag(x$ref,"currentTest"),  ...)
}
##################################################
## wrappers
## use lm function
gui.lm = function(container=NULL) {
  actions =list(
    "drop1" = list(
      FUN = "drop1"
      ),
    "plot: Residuals vs Fitted" =list(
      FUN="plot",
      ARGS = list(which=1)
      ),
    "plot: Normal Q-Q"=list(
      FUN="plot",
      ARGS = list(which=2)
      ),
    "plot: Scale-Location"=list(
      FUN="plot",
      ARGS = list(which=3)
      ),
    "plot: Cook's distance"=list(
      FUN="plot",
      ARGS = list(which=4)
      ),
    "plot: Residuals vs Leverage"=list(
      FUN="plot",
      ARGS = list(which=5)
      ),
    "plot: Cook's distance vs Leverage"=list(
      FUN="plot",
      ARGS = list(which=6)
      )
    )
  dynamicModelWidget(FUN="lm", actions=actions, container=container)
}

gui.rlm = function(container=NULL) {
  require(MASS)
  ## actions inherit from lm. -- sublcass?
  actions =list(
    "plot: Residuals vs Fitted" =list(
      FUN="plot",
      ARGS = list(which=1)
      ),
    "plot: Normal Q-Q"=list(
      FUN="plot",
      ARGS = list(which=2)
      ),
    "plot: Scale-Location"=list(
      FUN="plot",
      ARGS = list(which=3)
      ),
    "plot: Cook's distance"=list(
      FUN="plot",
      ARGS = list(which=4)
      ),
    "plot: Residuals vs Leverage"=list(
      FUN="plot",
      ARGS = list(which=5)
      ),
    "plot: Cook's distance vs Leverage"=list(
      FUN="plot",
      ARGS = list(which=6)
      )
    )
  dynamicModelWidget(FUN="rlm", actions=actions, container=container)
}

## use aov
gui.aov = function(container=NULL) {
  ## actions inherit from lm. -- sublcass?
  actions =list(
    "plot: Residuals vs Fitted" =list(
      FUN="plot",
      ARGS = list(which=1)
      ),
    "plot: Normal Q-Q"=list(
      FUN="plot",
      ARGS = list(which=2)
      ),
    "plot: Scale-Location"=list(
      FUN="plot",
      ARGS = list(which=3)
      ),
    "plot: Cook's distance"=list(
      FUN="plot",
      ARGS = list(which=4)
      ),
    "plot: Residuals vs Leverage"=list(
      FUN="plot",
      ARGS = list(which=5)
      ),
    "plot: Cook's distance vs Leverage"=list(
      FUN="plot",
      ARGS = list(which=6)
      )
    )
 
  dynamicModelWidget(FUN="aov", actions=actions, container=container)
}
##################################################

### workhorse functino
dynamicModelWidget = function(
  FUN = "lm",
  extra.args = NULL,
  actions = c(),                        # for actions window. Called on obj
  container = NULL,
  ...) {

  group = ggroup(horizontal=FALSE, container = container)
  obj = list(ref=group)
  class(obj) = c("gDynamicModel","gComponent","gWidget")

  ## store values
  tag(obj$ref,"FUN") <- FUN
  tag(obj$ref,"extra.args") <- extra.args

  formulaGroup = ggroup(container=group)
  ## key widgets:
  responseVar = glabel("response", container=formulaGroup,editable=TRUE)
  font(responseVar) <-  c(style="bold")
  tag(obj$ref,"responseVar") <- responseVar
  tag(obj$ref, "responseVarData") <- NA

  glabel(" ~ ", container=formulaGroup)
  
  intercept = gdroplist(c("1","-1"), container=formulaGroup)
  tag(obj$ref,"intercept") <- intercept

  predictorVars = glabel("predictor(s)",container=formulaGroup, editable=TRUE)
  font(predictorVars) <- c(style="bold")
  tag(obj$ref,"predictorVars") <- predictorVars
  tag(obj$ref,"predictorVarsData") <- list()

  addSpring(formulaGroup)
  actionPopup = gdroplist(c(
    "Select an action","Clear formula","Save model object",
    names(actions)),
    container = formulaGroup)
  tag(obj$ref,"actionPopup") <- actionPopup
  tag(obj$ref,"actions") <- actions
  
  gseparator(container=group)  
  outputArea = gtext("")
  size(outputArea) <-  c( 300,300)
  add(group, outputArea, expand=TRUE)
  tag(obj$ref,  "outputArea") <- outputArea

  tag(obj$ref, "res") <- NA
  ## store the drop handlers in the main object.
  tag(obj$ref, "dropHandlers")  <- list()

  ## add droptargets, handlers
  addhandlerchanged(responseVar,
                    handler = function(h,...) {
#                      cat("This doesn't work with dynamic data\n")
                      ids = tag(obj$ref,"dropHandlers")
                      if(length(ids) > 0) {
                        removehandler(obj$ref,ids)
                        tag(obj$ref,"dropHandlers") <- list()
                      }
                      
                      tag(obj$ref,  "responseVarData") <- svalue(responseVar)

                      
                      ## put popup on 1
                      svalue(tag(obj$ref,"actionPopup"),index=TRUE) <- 1
                      
                      update(obj)
                    })
  adddroptarget(responseVar,
                handler=function(h, ...) {
                  
                  tag(obj$ref,"responseVarData") <- h$dropdata
                  svalue(tag(obj$ref, "responseVar")) <- id(h$dropdata)
                  ## put popup on 1
                  svalue(tag(obj$ref,"actionPopup"),index=TRUE) <- 1
                  
                  update(obj)

                  ## now bind to be dynamic *if* a treeviewcolumn
                  if(is.gdataframecolumn(h$dropdata)) {
                    view.col = h$dropdata
                    id = addhandlerchanged(view.col,
                      signal = "edited",
                      handler=function(h,...) update(obj)
                      )
                    dropHandlers = tag(obj$ref,"dropHandlers")
                    dropHandlers[[length(dropHandlers)+1]] = list(
                                  view.col = view.col,
                                  id = id
                                  )
                    tag(obj$ref,"dropHandlers") <- dropHandlers
                  }
                })

  addhandlerchanged(intercept, handler=function(h,...) {
    ## put popup on 1
    svalue(tag(obj$ref,"actionPopup"),index=TRUE) <- 1

    update(obj)
  })
  addhandlerchanged(predictorVars,
                    handler = function(h,...) {
                      ## we need to be careful here. This overwrites any drop data.
                      cat("This doesn't work with dynamic data\n")
                      ids = tag(obj$ref,"dropHandlers")
                      if(length(ids) > 0) {
                        removehandler(obj$ref,ids)
                        tag(obj$ref,"dropHandlers") <- list()
                      }

                      vals = svalue(predictorVars)

                      ## clear out any leading or trailing +
                      vals = sub("\\s*[+]\\s*","",vals)
                      if(vals == "")    # in case of cleaning
                        vars = NULL
                      else 
                        vars = sapply(strsplit(vals,"\\+"),stripWhiteSpace)
                      tag(obj$ref,  "predictorVarsData") <- vars

                      ## add to predictorVars
                      if(is.null(vars))
                        svalue(predictorVars) <- "predictor(s)" # leave target
                      else
                        svalue(predictorVars) <- paste("+",paste(vars,collapse=" + "),collapse="  ")
                      ## put popup on 1
                      svalue(tag(obj$ref,"actionPopup"),index=TRUE) <- 1
                      
                      update(obj)
                    })

  adddroptarget(predictorVars,
                handler = function(h,...) {
                  varList = tag(obj$ref,"predictorVarsData")
                  if(!is.list(varList)) 
                    varList = list()
                  n = length(varList)
                  varList[[n+1]] = h$dropdata
                  tag(obj$ref,"predictorVarsData") <- varList
                  predictorVars = tag(obj$ref,"predictorVars")
                  curLabel = svalue(predictorVars)
                  if(curLabel == "predictor(s)")
                    curLabel = ""                   
                  newLabel = Paste(curLabel," + ", id(h$dropdata))
                  svalue(predictorVars) <- newLabel
                  update(obj)

                  ## now bind to be dynamic *if* a treeviewcolumn
                  if(is.gdataframecolumn(h$dropdata)) {
                    view.col = h$dropdata
                    id = addhandlerchanged(view.col,
                      signal = "edited",
                      handler=function(h,...) update(obj)
                      )
                    dropHandlers = tag(obj$ref,"dropHandlers")
                    dropHandlers[[length(dropHandlers)+1]] = list(
                                  view.col = view.col,
                                  id = id
                                  )
                    tag(obj$ref,"dropHandlers") <- dropHandlers
                  }
                })


  actionPopupHandler = handler = function(h,...) {
    if(svalue(h$obj) == "Select an action") {
      ## do nothing
    } else if(svalue(h$obj) == "Clear formula") {
      ## clear out values, labels
      tag(obj$ref,"responseVarData") <- NA
      svalue(responseVar) <-"response"
      
      svalue(intercept,index=TRUE) <- 1
      
      tag(obj$ref,"predictorVarsData") <- list()
      svalue(predictorVars) <- "predictor(s)"
      
      dispose(outputArea)
      ## would like to reset popup, bu tthis causes infinite loop
      ## clear out res
      tag(obj$ref, "res") <- NA
      
    } else if(svalue(h$obj) == "Save model object") {
      ## pop up a dialog to save the model object
      saveHandler = function(h,...) {
        varName = svalue(theName)
        if(!is.empty(varName)) {
          varName = make.names(varName)
          assign(varName, tag(obj$ref,"res"), envir=.GlobalEnv)
          dispose(win)
        }
      }

      win = pmgWC$new("Save model object as...", visible=TRUE)
      gp = ggroup(horizontal=FALSE, container=win)
      glabel("Specify a variable name for the object:", container=gp)
      theName = gedit("",container=gp, handler=saveHandler)
      if(length(lsModels()) > 0) theName[]<- lsModels() # add to type ahead
      buttonGroup = ggroup(container=gp)
      addSpring(buttonGroup)
      gbutton("ok", container=buttonGroup, handler =saveHandler)
      gbutton("cancel", container=buttonGroup, handler = function(h,...) dispose(win))
      ## that's all
    } else {
      argList = c(list(obj),actions[[svalue(h$obj)]]$ARGS)
      do.call(actions[[svalue(h$obj)]]$FUN, argList)
      
    }
  }

  ## how to set value of popup back to start without call ing handler?
  addhandlerchanged(actionPopup,handler=actionPopupHandler)
  
  return(obj)
}


## regular model methods
summary.gDynamicModel = function(object, ...)
  summary(tag(object$ref,"res"), ...)
anova.gDynamicModel = function(object, ...)
  anova(tag(object$ref,"res"), ...)
coefficients.gDynamicModel = function(object,...)
  coefficients(tag(object$ref,"res"), ...)
effects.gDynamicModel  = function(object,...)
  effects(tag(object$ref,"res"), ...)
fitted.values.gDynamicModel = function(object,...)
  fitted.values(tag(object$ref,"res"), ...)
residuals.gDynamicModel = function(object, ...) 
  residuals(tag(object$ref,"res"),  ...)
predict.gDynamicModel = function(object, ...) 
  predict(tag(object$ref,"res"),  ...)
plot.gDynamicModel = function(x, ...) 
  plot(tag(x$ref,"res"),  ...)

## This is main function
## call function, update widgets
## this is *not* the update for models traditionally expected
update.gDynamicModel = function(object, ...) {
  obj = object$ref                        # for s3 consistency

  
  FUN = tag(obj,"FUN")
  extra.args = tag(obj,"extra.args")

  responseVarData = tag(obj,"responseVarData")
  intercept = tag(obj,"intercept")
  intercept.val = svalue(intercept) # a string
  predictorVarsData = tag(obj,"predictorVarsData") # a list

  
  ## make formula
  ## how to avoid eval(parse... here?
  if(is.na(responseVarData)) {
    cat("Need a response variable\n")
    return()
  }

  env = environment()
  assign(id(responseVarData),svalue(responseVarData), envir=env)

  if(length(predictorVarsData) > 0) {
    sapply(predictorVarsData, function(i)
           assign(id(i), svalue(i), envir=env) ) 
  }

  formula = Paste(id(responseVarData), " ~ ", intercept.val)
  if(length(predictorVarsData) > 0) {
    formula = Paste(formula," + ",
      paste(sapply(predictorVarsData, function(i) id(i)), collapse=" + "))
  }

  command = Paste(FUN,"(",formula)
  if(!is.null(extra.args))
    command = Paste(command,",", extra.args)
  command = Paste(command, ")")

  
  res = eval(parse(text=command), envir=env)
  tag(obj,"res") <- res

  if(FUN == "aov")
    out = c(capture.output(res),"\n","Summary:","\n", capture.output(summary(res)))
  else
    out = capture.output(summary(res))
  

  outputArea = tag(obj,"outputArea")
  dispose(outputArea)
  for(i in out) {
    if(length(grep(":$",i)) > 0)
      add(outputArea,i,font.attr=c("monospace","blue"))
    else
      add(outputArea,i,font.attr=c("monospace"))
  }
}

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/dSummaryDialog.R"

dSummaryDialog = function(container=NULL) {

  defaultMsg = "Drop variable here"
  dynamicWarning = "Editing values doesn't work with dynamic data"
  
  ## default is to have a window
  if(is.null(container))
    container = pmgWC$new("Dynamic Summaries", visible=TRUE)

  gp = ggroup(horizontal = FALSE, container=container, raise.on.dragmotion = TRUE)
  obj = gp
#  class(obj) = c("gDSummary","gComponent","gWidget")


  tag(obj,"dropHandlers") <- list()
  
  tbl = glayout()

  tbl[1,1] = glabel("x:")
  tbl[2,1] = glabel("[y]:")
  tbl[3,1] = glabel("[group by]:")

  
  xVar = glabel(defaultMsg,editable=TRUE)
  font(xVar) <- c(style="bold")
  tag(obj,"xVarData") <- NULL
  tbl[1,2] = xVar

  yVar = glabel(defaultMsg,editable=TRUE)
  font(yVar) <- c(style="bold")
  enabled(yVar)<-FALSE                  # initially not enabled
  tag(obj,"yVarData") <- NULL
  tbl[2,2] = yVar

  groupingVar = glabel(defaultMsg,editable=TRUE)
  font(groupingVar) <- c(style="bold")
  tag(obj,"groupingVarData") <- NULL
  tbl[3,2] = groupingVar

  add(gp,tbl)
  visible(tbl) <- TRUE

  popupGroup = ggroup(container=gp)
  addSpring(popupGroup)
  gbutton("clear",container=popupGroup, handler=function(h,...) clear())
  glabel("Select summary:",container=popupGroup)

  ## changes here need to propogate to indices below
  univariateSummaries = c("summary","length","mean","median","sd","IQR","mad","range","skewness","kurtosis")
  bivariateSummaries = c("cor")
  actionPopup = gdroplist(
#    c("Clear variables",
    c("--- Summary ---",
      univariateSummaries[1:2],
      "--- Center ---",
      univariateSummaries[3:4],
      "--- Spread ---",
      univariateSummaries[5:8],
      "--- Shape ---",
      univariateSummaries[9:length(univariateSummaries)],
      "--- Bivariate ---",
      bivariateSummaries
      ),selected=3, container=popupGroup)

  gseparator(container=gp)
  summaryArea = gtext()
  add(gp,summaryArea, expand=TRUE)
  add(summaryArea,
      c("Add variables above either by clicking on bold-faced values, or dragging and dropping values.",
        "The summary appears in this window.",
        "The 'Clear variables' options resets the values."))

  ## add handlers
  addhandlerchanged(xVar,
                    handler = function(h,...) {
                      cat(dynamicWarning,"\n")
                      ids = tag(obj,"dropHandlers")
                      if(length(ids) > 0) {
                        removehandler(obj,ids)
                        tag(obj,"dropHandlers") <- list()
                      }
                      tag(obj, "xVarData") <- svalue(h$obj)
                      ## put popup on 1
                      ## svalue(tag(obj,"actionPopup"),index=TRUE) <- 1
                      
                      update()
                    })
  adddroptarget(xVar,
                handler=function(h, ...) {
                  tag(obj,"xVarData") <- h$dropdata
                  svalue(xVar) <- id(h$dropdata)
                  ## put popup on 1
                  ## svalue("actionPopup",index=TRUE) <- 1
                  
                  update()

                  ## now bind to be dynamic *if* a treeviewcolumn
                  if(is.gdataframecolumn(h$dropdata)) {
                    view.col = h$dropdata
                    id = addhandlerchanged(view.col,
                      signal = "edited",
                      handler=function(h,...) update()
                      )
                    dropHandlers = tag(obj,"dropHandlers")
                    dropHandlers[[length(dropHandlers)+1]] = list(
                                  view.col = view.col,
                                  id = id
                                  )
                    tag(obj,"dropHandlers") <- dropHandlers
                  }
                })
  ## yvar
  addhandlerchanged(yVar,
                    handler = function(h,...) {
                      cat(dynamicWarning,"\n")
                      ids = tag(obj,"dropHandlers")
                      if(length(ids) > 0) {
                        removehandler(obj,ids)
                        tag(obj,"dropHandlers") <- list()
                      }
                      tag(obj,  "yVarData") <-  svalue(h$obj)
                      ## put popup on 1
                      ## svalue(tag(obj,"actionPopup"),index=TRUE) <- 1
                      
                      update()
                    })
  adddroptarget(yVar,
                handler=function(h, ...) {
                  tag(obj,"yVarData") <- h$dropdata
                  svalue(yVar) <-  id(h$dropdata)
                  ## put popup on 1
                  ## svalue("actionPopup", index=TRUE) <- 1
                  
                  update()

                  ## now bind to be dynamic *if* a treeviewcolumn
                  if(is.gdataframecolumn(h$dropdata)) {
                    view.col = h$dropdata
                    id = addhandlerchanged(view.col,
                      signal = "edited",
                      handler=function(h,...) update()
                      )
                    dropHandlers = tag(obj,"dropHandlers")
                    dropHandlers[[length(dropHandlers)+1]] = list(
                                  view.col = view.col,
                                  id = id
                                  )
                    tag(obj,"dropHandlers") <- dropHandlers
                  }
                })


    addhandlerchanged(groupingVar,
                    handler = function(h,...) {
                      cat(dynamicWarning,"\n")
                      ids = tag(obj,"dropHandlers")
                      if(length(ids) > 0) {
                        removehandler(obj,ids)
                        tag(obj,"dropHandlers") <- list()
                      }
                      tag(obj,  "groupingVarData") <-  svalue(h$obj)
                      ## put popup on 1
                      ## svalue(tag(obj,"actionPopup"),index=TRUE) <- 1
                      
                      update()
                    })
  adddroptarget(groupingVar,
                handler=function(h, ...) {
                  tag(obj,"groupingVarData") <- h$dropdata
                  svalue(groupingVar) <-  id(h$dropdata)
                  ## put popup on 1
                  ## svalue("actionPopup",index=TRUE) <- 1
                  
                  update()

                  ## now bind to be dynamic *if* a treeviewcolumn
                  if(is.gdataframecolumn(h$dropdata)) {
                    view.col = h$dropdata
                    id = addhandlerchanged(view.col,
                      signal = "edited",
                      handler=function(h,...) update()
                      )
                    dropHandlers = tag(obj,"dropHandlers")
                    dropHandlers[[length(dropHandlers)+1]] = list(
                                  view.col = view.col,
                                  id = id
                                  )
                    tag(obj,"dropHandlers") <- dropHandlers
                  }
                })

  addhandlerchanged(actionPopup, handler = function(h,...) {
    actionVal = svalue(actionPopup)
    if(actionVal == "Select summary:") {

    } else if(actionVal == "Clear variables") {
      clear()
      enabled(yVar)<-FALSE
    } else if(length(grep("^---",actionVal))>0) {
      ##cat("No summary selected")
      clear()
      enabled(yVar)<-FALSE
    } else {
      ## gray out y value unless action popup is in bivariate
      if(actionVal %in% bivariateSummaries) {
        enabled(yVar)<-TRUE
      } else {
        enabled(yVar)<-FALSE
      }
      update()                          # call update with new action
    }
  })
  
  ## three actions: clear, update, unrealize
  clear = function() {
    svalue(xVar) <- defaultMsg
    svalue(yVar) <- defaultMsg
    svalue(groupingVar) <- defaultMsg
    dispose(summaryArea)
    
    tag(obj,"xVarData") <- NULL
    tag(obj,"yVarData") <- NULL
    tag(obj,"groupingVarData") <-  NULL

    clearDropHandlers()
  }

  update = function() {
    ## get variables
    xVarData = tag(obj,"xVarData")
    yVarData = tag(obj,"yVarData")
    groupingVarData = tag(obj,"groupingVarData")
    actionVal = svalue(actionPopup)

    ## proceed?
    if(is.null(xVarData)) {
      cat("Need data in the x variable\n")
      return()
    }
    if(actionVal %in%   c("Select summary:","Clear variables") ||
       length(grep("^---", actionVal)) >0 
       ) {
      return()
    }

    ## update summaryArea
    envir = environment()               # use eval(parse... here
    assign(id(xVarData),svalue(xVarData), envir=envir)
    if(actionVal %in% univariateSummaries) { ##is.null(yVarData)
      if(is.null(groupingVarData)) {
        command = Paste(actionVal,"(",id(xVarData),")")
      } else {
        assign(id(groupingVarData),svalue(groupingVarData), envir=envir)
        command = Paste("sapply(split(",id(xVarData),",",
          id(groupingVarData),"),",actionVal,")")
      }
    } else {
      ## yVar is good, how about group
      assign(id(yVarData),svalue(yVarData), envir=envir)
      if(is.null(groupingVarData)) {
        command = Paste(actionVal,"(",
          id(xVarData),",",id(yVarData),
          ")")
      } else {
        ## bivariate summary
        assign(id(groupingVarData),svalue(groupingVarData), envir=envir)
        d = data.frame(svalue(xVarData),svalue(yVarData))
        names(d) = c(id(xVarData),id(yVarData))
        assign("d",d, envir=envir)
        command = Paste("sapply(split(d,", id(groupingVarData),"),",
          "function(x)", actionVal,"(x[,1],x[,2])",
          ")")
      }
    }
    ## cat(options("prompt"), command,"\n")
    out = capture.output(eval(parse(text=command), envir=envir))

    dispose(summaryArea)
    add(summaryArea, command,font.attr=c("monospace","blue"))
    add(summaryArea, out, font.attr=c("monospace"))

  }
  
  ## clear out view.col handlers
  clearDropHandlers = function(...) {
    dropHandlers = tag(obj,"dropHandlers")
    if(length(dropHandlers) > 0) {
      for(i in 1:length(dropHandlers)) {
        removehandler(dropHandlers[[i]]$view.col,dropHandlers[[i]]$id)
      }
    }
  }
  addhandlerunrealize(obj, handler = clearDropHandlers)
  
  return(obj)
}
  
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/dpgrFuncs.R"
## general interface for finding probabilities

## rpel = function(string, envir=.GlobalEnv) {
##   eval(parse(text=string), envir=envir)
## }


####
dpqrfuncs = function(type=c("p","d","q","r"), container=NULL) {

  randomFamilies = list(
    "norm" = c("mean","sd",0,1),
    "t" = c("df","ncp","",0),
    "f" = c("df1","df2","",""),
    "chisq" = c("df","ncp","",0),
    "unif" = c("min","max",0,1),
    "exp" =  c("rate",1),
    "weibull" = c("shape","scale","",1),
    "gamma" = c("shape","rate","",1),
    "beta" = c("shape1","shape2","",""),
    "cauchy" = c("location","scale","",""),
    "logis" = c("location","scale",0,1),
    "lnorm" = c("meanlog","sdlog",0,1),
    "pois" = c("lambda","",1,""),
    "binom"=c("size","prob",1,.5),
    "geom" = c("prob",""),
    "nbinom" = c("size","prob","","")
    )
  helpPage = c(
    "norm" = "Normal",
    "t" = "TDist",
    "f" = "FDist",
    "chisq" = "Chisquare",
    "unif" = "Uniform",
    "exp" =  "Exponential",
    "weibull" = "Weibull",
    "gamma" = "Gamma",
    "beta" = "Beta",
    "cauchy" = "Cauchy",
    "logis" = "Logistic",
    "lnorm" = "Lognormal",
    "pois" = "Poisson",
    "binom"= "Binomial",
    "geom" = "Geometric",
    "nbinom" = "NegBinomial"
    )
  
  theFirstArg = c("p"="q","d"="x","q"="p","r"="n")
  doWhat = c("p"="Probability","d"="p.d.f","q"="Quantile","r"="Random sample")
  
  
  type = match.arg(type)
    
  gp = ggroup(horizontal=FALSE, container=container)
  glabel(paste("Find a",doWhat[type]), container=gp)

  ## widgets
  distSelector = gdroplist(paste(type,names(randomFamilies),sep=""))
  sampleSize = gedit(1) #, coerce.with=rpel)


  param1label = glabel("mean")
  param1 = gedit("0") #, coerce.with=rpel)
  param2label = glabel("sd")
  param2 = gedit("1") #, coerce.with=rpel)
  doLog = gcheckbox("")
  doLowerTail = gcheckbox("",checked=TRUE)
  doLogP = gcheckbox("")
  
  saveAs = gedit("")

  output = gtext("", font.attr=c("monospace"))

  ## layout
  tbl = glayout(container=gp)
  tbl[1,1] = glabel("Choose a distribution")
  tbl[1,2] = distSelector
  tbl[2,1] = glabel(theFirstArg[type])
  tbl[2,2] = sampleSize
  tbl[3,1] = param1label
  tbl[3,2] = param1
  tbl[4,1] = param2label
  tbl[4,2] = param2
  
  i = 5
  if(type == "d") {
    tbl[5,1] = glabel("log"); tbl[5,2] = doLog
    i = 6
  } else if (type %in% c("p","q")) {
    tbl[5,1] = glabel("lower.tail");tbl[5,2] = doLowerTail
    tbl[6,1] = glabel("log.p"); tbl[6,2] = doLogP
    i = 7
  }
  
  tbl[i,1] = glabel("Save output as:")
  tbl[i,2] = saveAs

  bgp = ggroup(cont=gp)
  tbl[i+1,2] <- bgp
  addSpring(bgp)
  findSample = gbutton("ok",cont=bgp)
  helpButton = gbutton("help", cont=bgp)

  visible(tbl) <- TRUE

  ## replace, using pmg.cli now
  ## add(gp, output, expand = TRUE)  

  ### actions
  ## select distr, update parameters
  addhandlerchanged(distSelector, handler = function(h,...) {

    theFunc = svalue(distSelector)
    theDist = substr(theFunc,2,stop=nchar(theFunc))
    theParams = randomFamilies[[theDist]]

    ## enabled?
    if(length(theParams) == 2) {
      svalue(param2) <- ""; enabled(param2) <- FALSE
    } else {
      ## ensure they are on
      enabled(param2label) <- TRUE
      enabled(param2) <- TRUE
    }

    ## param1
    svalue(param1label) <- theParams[1]
    svalue(param1) <- theParams[3]
    if(length(theParams) == 2) {
      svalue(param2label) <- ""
      svalue(param2) <- ""
    } else {
      svalue(param2label) <- theParams[2]
      svalue(param2) <- theParams[4]
    }

    ## clear output
    svalue(output) <- ""
  })
    

  ## click OK
  addhandlerchanged(findSample, handler = function(h,...) {

    theFunc = svalue(distSelector)
    theDist = substr(theFunc,2,stop=nchar(theFunc))
    theParams = randomFamilies[[theDist]]


    ## We paste together a command to use with pmg.cli, not a do.
##     theArgs = list()
##     theArgs[[theFirstArg[type]]]=svalue(sampleSize)
##     theArgs[[theParams[1]]] <- svalue(param1)
##     if(length(theParams) > 2)
##       theArgs[[theParams[2]]] <- svalue(param2)
##     if(type == "d") {
##       if(svalue(doLog))
##         theArgs[["log"]]=TRUE
##     } else if (type %in% c("p","q")) {
##       if(svalue(doLowerTail) == FALSE)
##         theArgs[["lower.tail"]] = FALSE
##       if(svalue(doLogP))
##         theArgs[["log.p"]] = TRUE
##     }

##     res = do.call(theFunc, theArgs)

##     ## save 
##     if(svalue(saveAs) != "")
##       assign(svalue(saveAs),res, envir=.GlobalEnv)
##     ## update output
##     oldWidth = getOption("width"); options("width"=60)
##     svalue(output) <- capture.output(print(res))
##     options(width=oldWidth)

    cmd = paste(theFunc,"(",sep="")
    cmd = paste(cmd, theFirstArg[type], "=", svalue(sampleSize), sep="")
    cmd = paste(cmd, ",", theParams[1], "=",  svalue(param1), sep="")
    if(length(theParams) >2)
      cmd = paste(cmd, ",", theParams[2], "=",  svalue(param2), sep="")
    if(type == "d") {
      if(svalue(doLog))
        cmd = paste(cmd, ", log=TRUE", sep="")
    }
    if(type %in% c("p","q")) {
      if(svalue(doLowerTail) == FALSE)
        cmd = paste(cmd, ", lower.tail=FALSE", sep="")
      if(svalue(doLogP))
        cmd = paste(cmd, ", log.p=TRUE", sep="")
    }
    cmd = paste(cmd, ")", sep="")

    ## do we save as something?
    if(svalue(saveAs) != "")
      names(cmd) <- make.names(svalue(saveAs))

    svalue(pmg.cli) <- cmd
      
      

    
  })
  ## help
  addhandlerchanged(helpButton, handler = function(h,...) {
    theFunc = svalue(distSelector)
    theDist = substr(theFunc,2,stop=nchar(theFunc))    
    ghelp(helpPage[theDist], container=pmgWC$new(paste("Help on",theFunc)))
  })

  ##
  return(gp)
}

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/hacks.R"
### These are also in gWidgetsRGtk/R/common.R -- in NAMESPACE NOW, along with untaintName,
#Paste = function(..., sep="", collapse="") {
#  x = unlist(list(...))
#  x = x[!is.na(x)]
#  x = x[x != "NA"]
#  paste(x, sep=sep, collapse=collapse)
#}

### ReadParseEvaL -- saves typing
#rpel = function(string, envir=.GlobalEnv) {
#  eval(parse(text=string), envir=envir)
#}

hack.as.data.frame = function(items) {
  ## check rectangular, or coerce to rectangules
  if(!(is.data.frame(items) || is.matrix(items) || is.vector(items))) {
    warning("Needs rectangular data, either a vector, matrix or data.frame")
    return(NA)
  }
  
  ## coerce to data frame
  if(is.vector(items)) {
    itemsName = deparse(substitute(items))
    items = data.frame(I(items))
    names(items) = itemsName
  }
  if(is.matrix(items)) {
    items = hack.as.data.frame.matrix(items) # fun in common.R
  }
  return(items)
}

## no easy way to not convert character vectors. This is a hack.
hack.as.data.frame.matrix = 
  function (x, row.names = NULL, optional = FALSE) 
  {
    d <- dim(x)
    nrows <- d[1]
    ir <- seq(length = nrows)
        ncols <- d[2]
    ic <- seq(length = ncols)
    dn <- dimnames(x)
    if (missing(row.names)) 
      row.names <- dn[[1]]
    collabs <- dn[[2]]
    if (any(empty <- nchar(collabs) == 0)) 
      collabs[empty] <- paste("V", ic, sep = "")[empty]
    value <- vector("list", ncols)
    if (mode(x) == "character") {
      for (i in ic) value[[i]] <- as.character(x[, i])
    }
    else {
      for (i in ic) value[[i]] <- as.vector(x[, i])
    }
    if (length(row.names) != nrows) 
      row.names <- if (optional) 
        character(nrows)
      else as.character(ir)
    if (length(collabs) == ncols) 
      names(value) <- collabs
    else if (!optional) 
      names(value) <- paste("V", ic, sep = "")
        attr(value, "row.names") <- row.names
    class(value) <- "data.frame"
    value
  }

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/helpBrowser.R"
## this is for interface to help stuff within pmg
## much of this moved into ghelp.R via ghelpbrowser



## make a global
pmg.helppagebrowser = NA


### RSiteSearch Dialog
RSiteSearch.Dialog = function() {
  ## RSiteSearch
  win = pmgWC$new("RSiteSearch()", visible=TRUE)
  
  table = glayout()
  spacinggroup = ggroup(horizontal=FALSE)
  ##  sitegroup = ggroup(container=spacinggroup)
  ## iaddlabel(siteentry,"Search terms:", pos=2, container=spacinggroup)
  table[1,1] =  glabel("Search terms:")
  siteentry = gedit("", width=50)#,container=sitegroup)
  table[1,2:4] = siteentry
  
  
  restrict = c("","Rhelp02a","Rhelp01","docs","functions")
  restrictPopup = gdroplist(restrict,multiple=TRUE)#,container=spacinggroup)
                                        #  size(restrictPopup) <- c(200,200)
#  iaddlabel(restrictPopup, "Restrict to:",pos=2, container=spacinggroup)
  table[2,1] = glabel("Restrict to:")
  table[2:3,2] = restrictPopup
  
  matchesPerPage = gspinbutton(min=20,max=100,value=20, step=10)#,container=spacinggroup)
  table[4,1] = glabel("Matches per page:")
  table[4,2] = matchesPerPage
#  iaddlabel(matchesPerPage,"Matches per page", pos=2, container=spacinggroup)
#  addSpring(spacinggroup)
#  add(spacinggroup,sitebutton,expand=FALSE)
  visible(table) <-  TRUE
  gp = ggroup(horizontal=FALSE, container = win)
  glabel("RSiteSearch goes to the internet to find\nmatches to your queries. The results are shown\nin a browser window.",container=gp)
  add(gp,gseparator())
  add(gp, table)
  buttonGroup = ggroup(container=gp)
  addSpring(buttonGroup)
  sitebutton = gbutton("find", container=buttonGroup)
  add(buttonGroup, gbutton("cancel",handler=function(h,...) dispose(win)))
  
  addhandlerclicked(sitebutton,action=siteentry,handler=function(h,...) {
    restrictValues = svalue(restrictPopup)
    if(is.null(restrictValues) || restrictValues=="")
      restrictValues = restrict[-1] # all of them but ""
    matches = svalue(matchesPerPage)
    RSiteSearch(svalue(h$action), restrict=restrictValues, matchesPerPage=matches)
  })

}


### View Vignettes dialog
viewVignettes.Dialog = function() {
  allVignettes = getAllVignettes()

  defaultHandler = function(h,...) {
    tmp =  svalue(vignetteList, drop=FALSE)
    topic = tmp[1,2, drop=TRUE]
    package = tmp[1,1, drop=TRUE]
    cat("Show vignette for ",topic,"\n")
    print(do.call("vignette",list(topic=topic, package=package)))
  }
  
  vignetteList = gtable(as.data.frame(allVignettes),
    filter.column = 1,
    handler = defaultHandler
  )

  win = pmgWC$new("View vignette",v=T)
  gp = ggroup(horizontal=FALSE, container=win)
  add(gp, vignetteList, expand=TRUE)
  buttonGroup = ggroup(container=gp)
  addSpring(buttonGroup)
  gbutton("ok",container = buttonGroup, handler = defaultHandler)
  gbutton("cancel",container=buttonGroup, handler = function(h,...) dispose(win))
  size(win) <- c(450,300)
}

### Demos
viewDemos.Dialog = function() {
  allDemos = demo(package = .packages(all.available = TRUE))$results
  demoList = gtable(allDemos[,-2], chosencol = 2, filter.column=1)
  addhandlerdoubleclick(demoList, handler=function(h,...) {
    cat("Demo runs in command line area")
    item = svalue(h$obj, drop=FALSE)
    do.call("demo",list(topic=item[1,2,drop=TRUE], package=item[1,1,drop=TRUE]))
  })
  ## create widget
  win = pmgWC$new("View demo in command line",v=T)
  gp = ggroup(horizontal=FALSE, container=win)
  add(gp, demoList, expand=TRUE)
  buttonGroup = ggroup(container=gp)
  addSpring(buttonGroup)
  gbutton("ok",container = buttonGroup, handler = function(h,...) {
    cat("Demo runs in command line area")
    item = svalue(demoList, drop=FALSE)
    do.call("demo",list(topic=item[1,2,drop=TRUE], package=item[1,1,drop=TRUE]))
    })
  gbutton("cancel",container=buttonGroup, handler = function(h,...) dispose(win))
  size(win) <- c(450,300)
}

##################################################
## helper furntions
## list all packages
getAllPackages = function() .packages(all=TRUE)

#
getAllVignettes = function() {
  allVignettes = hack.as.data.frame.matrix(vignette()[[4]][,c(1,3)])
  ## just the Packages name and Item
  return(allVignettes)
}

## in ghelp of iWidgets
## contents a matrix with entry, keywords, description and URL
#getContentsOfPackage = function(package=NULL) {
#  if(is.null(package)) {
#    warning("Empty package name")
#    return(NA)
#  }
#  contents = read.dcf(system.file("CONTENTS",package=package))
  
#  return(data.frame(Entry=I(contents[,1]),Keywords=I(contents[,3]),
#                    Description=I(contents[,4])))
#}

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/iw.R"
##file import Wizard
##Uses BasicWidgets
##call pmg.specifyFileForImport to start it off

.l = list()
.l[[gettext("text files")]] = c("csv","txt","fwf")
.l[[gettext("ARFF files")]] = c("arff")
.l[[gettext("DBF files")]] = c("dbf")
.l[[gettext("Stata Binary files")]] = c("dta")
.l[[gettext("EPI info files")]] = c("epi")
.l[[gettext("Minitab Portable files")]] = c("mtp")
.l[[gettext("Octave text data files")]] = c("octave")
.l[[gettext("SPSS files")]] = c("sav")
.l[[gettext("SAS XPORT files")]] = c("xport")
.l[[gettext("Systat files")]] = c("sys","syd")
.l[[gettext("Excel files")]] = c("xls")
.l[[gettext("DIF files")]] = c("DIF","dif")
.l[[gettext("Open office files")]] = c("odt")
.l[[gettext("gnumeric files")]] = c("gnumeric")
.fileExtensions =  .l

## .fileExtensions =  list(
##   "text files" = c("csv","txt","fwf"),
##   "ARFF files" = c("arff"),
##   "DBF files" = c("dbf"),
##   "Stata Binary files" = c("dta"),
##   "EPI info files" = c("epi"),
##   "Minitab Portable files" = c("mtp"),
##   "Octave text data files" = c("octave"),
##   "SPSS files" = c("sav"),
##   "SAS XPORT files" = c("xport"),
##   "Systat files" = c("sys","syd"),
##   "Excel files" = c("xls"),
##   "DIF files" = c("DIF","dif"),
##   "Open office files" = c("odt"),
##   "gnumeric files" = c("gnumeric")
##   )
## strip last character
pop = function(x) x[-length(x)]
popchar = function(str) paste(pop(unlist(strsplit(str,""))),collapse="")

selectFile = function(initialFile = NULL) {

  filterList = lapply(.fileExtensions, function(i) list(patterns = paste("*.",i,sep="")))
  filterList$"All files" = list(patterns=c("*"))
  gfile(text = "Select a file for import",
        initialfilename = initialFile,
        filter = filterList
        )
}


## specify with a URL or a filebrowse
pmg.specifyFileForImport = function(...) {

  filterList = lapply(.fileExtensions, function(i) list(patterns = paste("*.",i,sep="")))
  filterList$"All files" = list(patterns=c("*"))

  GUI = BasicGUI$new(message=gettext("Select a file to import"))
  GUI$filterList = filterList
  GUI$useDefaultText = gettext("<use file extension to determine>")
  GUI$fileSelectDefaultText = gettext("Specify a file or url...")
  GUI$makeBody = function(., container) {
    g = ggroup(horizontal=FALSE, cont=container)
    tbl = glayout(cont=g)
    tbl[1,1] <- "local file"
    tbl[1,2] <- (.$filebrowse = gfilebrowse(text=.$fileSelectDefaultText,
                   action=invisible,
                   container=tbl, filter=.$filterList, quote=FALSE))
    tbl[2,1] <- (l <- glabel(gettext("or"),cont=tbl))
    font(l) <- c(style="italic")
    tbl[2,2] <- gseparator(cont=tbl)
    tbl[3,1] <- "url"
    tbl[3,2] <- (.$url = gedit("", container=tbl))

    tbl[4,1:2] <- gseparator(cont=tbl)
    tbl[5,1] = gettext("File type is")
    tbl[5,2] <- (.$filetype = gdroplist(c(
      .$useDefaultText,
      sapply(names(filterList),popchar)
      ), cont=tbl))

    visible(tbl) <- TRUE
  }
  GUI$clearButtonHandler = NULL
  GUI$okButtonHandler = function(.,h,...) {
    ## what to do? need *local* filename and type
    ## if url, but no file, then we download file name it, go
    ## if file then go to next

    .$theFile = svalue(.$filebrowse)
    theURL = svalue(.$url)
    .$ext = NULL ## the extension, figure out


    if(.$theFile == .$fileSelectDefaultText || !file.exists(.$theFile)) {
      ## try to get the URL
      .$theFile= tempfile()
      out = try(download.file(theURL, destfile = .$theFile))
      if(inherits(out,"try-error")) {
        sprintf("Error downloading file: %s\n",out)
        return(TRUE)
      }
      ## we saved to out
      ## guess extension from $url
      tmp = unlist(strsplit(basename(theURL), split="\\."))
      .$ext = tmp[length(tmp)]
    }
    ##  file is now theFile
    ## get extension type from droplist

    fileType = svalue(.$filetype)

    if(fileType != .$useDefaultText) {
      ## use filterList to get
      fileType = paste(fileType,"s", sep="", collapse="") ## append s back
      .$ext = .fileExtensions[[fileType]][1]
      sprintf("Set extension to %s \n",.$ext)
    } else if(is.null(.$ext)) {
      tmp = unlist(strsplit(basename(.$theFile), split="\\."))
      .$ext = tmp[length(tmp)]
    } 
    ## now we have .$theFile and .$ext move on
    dispose(.$window)

    importFile(.$theFile, .$ext)
  }

  ## now draw GUI
  GUI$show()
}


importFile = function(filename, ext=NULL) {

  if(missing(filename))
    filename = selectFile()



  GUI = BasicGUI$new(message=paste("import", filename,collapse=" "))
  GUI$filename = filename
  GUI$ext = ext
  GUI$AssignToText = gettext("Assign to:")
  GUI$clearButtonHandler = NULL
  GUI$okButtonHandler = function(.,h,...) {
    ## the functions below define FUN, args, and varName
    out = try(do.call(.$FUN,lapply(args,svalue)), silent=TRUE)
    if(inherits(out,"try-error")) {
      sprintf("Error: %s \n",out)
    } else {
      varName = make.names(svalue(.$varName))
      ## can't have empty names due to make.names

      ## check if there already
      curVars = ls(envir=.GlobalEnv)
      if(varName %in% curVars) {
        override = gconfirm(
          sprintf("A variable %s already exists. Overwrite?",varName)
          )
        if(override == FALSE)
          return(TRUE)
      }
      assign(make.names(varName),out,envir=.GlobalEnv)
      dispose(.$window) ## clean up
    }
  }
  GUI$makeBody = function(.,container) {
    .$container = container             # store
    ## dispatch various functions depending on type of filename
    if(is.null(.$ext)) {
      tmp = unlist(strsplit(basename(.$filename), split="\\."))
      .$ext = tmp[length(tmp)]
    }
    ## now what is the ext
    switch(.$ext,
           "csv" = .$read_text(sep=","),
           "txt" = .$read_text(sep=""),
           "fwf" = .$read_fwf(sep=","),
           "arff" = .$read_foreign(type="arff"),
           "dbf"= .$read_foreign(type="dbf"),
           "DIF" = .$read_DIF(),
           "dta"= .$read_foreign(type="dta"),
           "epi"= .$read_foreign(type="epi"),
           "mtp"= .$read_foreign(type="mtp"),
           "octave"= .$read_foreign(type="octave"),
           "sav"= .$read_foreign(type="spss"),
           "ssd"= .$read_foreign(type="ssd"),
           "xport"= .$read_foreign(type="xport"),
           "systat"= .$read_foreign(type="systat"),
           "xls"= .$read_spreadsheet(type="xls"),
           "odt" = .$read_spreadsheet(type="odt"),
           "gnumeric" = .$read_spreadsheet(type="gnumeric"),
           .$read_text(sep=""))         # default
  }
  ## each of these has FUN="string", args=list(), varName
  ## will do do.call(FUN,lapply(args,svalue)) to get answer

  ## ITS ONE OF THESE?
  GUI$read_text = function(.,sep) {
    .$FUN = "read.table"
    .$args = list(file = gedit(.$filename))
    .$allSeps = c(",","\\t","",";","\\s") ## others?
    
    ## see ?read.table for numerous arguments

    g = ggroup(horizontal=FALSE, cont=.$container)
    glabel(sprintf("Read %s",basename(.$filename)), cont=g)

    tbl <- glayout(cont=g)
    tbl[1,1] <- .$AssignToText
    tbl[1,2] <- (.$varName <- gedit("X", cont=tbl))
    .$varName[] <- ls(envir=.GlobalEnv)
    visible(tbl) <- TRUE

         
    f= gframe(gettext("Import"), cont=g)
    tbl <- glayout(cont=f)
    tbl[1,1] <- gettext("header")
    tbl[1,2] <- (.$args[['header']] <- gdroplist(c(TRUE,FALSE), cont=tbl))
    tbl[1,3] <- gettext("Skip lines")
    tbl[1,4] <- (.$args[["skip"]] <- gspinbutton(0,1000, cont=tbl))
    tbl[2,1] <- gettext("Strip whitespace")
    tbl[2,2] <- (.$args[['strip.white']] <- gdroplist(c(TRUE,FALSE), cont=tbl))
    tbl[2,3] <- gettext("Skip blank lines")
    tbl[2,4] <- (.$args[['blank.lines.skip']] <- gdroplist(c(FALSE,TRUE), cont=tbl))

    visible(tbl) <- TRUE
    f = gframe(gettext("Attributes"), cont=g)
    tbl <- glayout(cont=f)
    tbl[1,1] <- gettext("Separator")
    tbl[1,2] <- (.$args[['sep']] <- gedit(sep, cont=tbl))
#    tbl[1,2] <- (.$args[['sep']] <- gdroplist(.$allSeps, editable=TRUE,cont=tbl))
#    svalue(.$args[['sep']]) <- sep
    
    tbl[1,3] <- gettext("quote")
    tbl[1,4] <- (.$args[['quote']] <- gedit("\"", cont=tbl))
    tbl[2,1] <- gettext("Decimal point")
    tbl[2,2] <- (.$args[["dec"]] <- gdroplist(c(".",","), cont=tbl))
    tbl[2,3] <- gettext("Comment char.")
    tbl[2,4] <- (.$args[['comment.char']] <- gedit("#", cont=tbl))
    tbl[3,1] <- gettext("NA string")
    tbl[3,2] <- (.$args[['na.strings']] <- gedit("NA", cont=tbl))

    visible(tbl) <- TRUE

    makePreview = function(...) {
      ## read in
      l <- lapply(.$args, svalue)
      l$nrows = 10
      df= try(do.call(.$FUN,l), silent=TRUE)
      print("DEBUG")
      print(df)
      if(!inherits(df,"try-error")) {
        delete(.$og,.$ig)
        .$ig <- ggroup(horizontal=FALSE, cont=.$og, expand=TRUE)
        tmp <- gdf(df,cont=.$ig) ## get rownames
##         enabled(tmp) <- FALSE ## too faint
      } else {
        cat(gettext("Error occured:"))
        print(df)
      }
    }

    ## do names?
    f = gframe(gettext("preview"), cont=g, expand=TRUE)
    .$og = ggroup(cont=f, expand=TRUE)
    .$ig = ggroup(cont=.$og, expand=TRUE)                # to be deleted
    makePreview()

    ## now add handler
    sapply(.$args, function(i) addHandlerChanged(i,handler = makePreview))
  }         
  GUI$read_fwf = function(.,sep) {
    .$FUN = "read.fwf"
    .$args = list(file = gedit(.$filename))

    g = ggroup(horizontal=FALSE, cont=.$container)
    glabel(paste(gettext("Read"),basename(.$filename),collapse=" "), cont=g)

    tbl <- glayout(cont=g)
    tbl[1,1] <- .$AssignToText
    tbl[1,2] <- (.$varName <- gedit("X", cont=tbl))
    .$varName[] <- ls(envir=.GlobalEnv)
    visible(tbl) <- TRUE

         
    f= gframe(gettext("Import"), cont=g)
    tbl <- glayout(cont=f)
    tbl[1,1] <- gettext("Header")
    tbl[1,2] <- (.$args[['header']] <- gdroplist(c(FALSE,TRUE), cont=tbl))
    tbl[1,3] <- gettext("Separator")
    tbl[1,4] <- (.$args[['sep']] <- gedit(sep, cont=tbl))
    tbl[2,1] <- gettext("Skip lines")
    tbl[2,2] <- (.$args[["skip"]] <- gspinbutton(0,1000, cont=tbl))
    tbl[2,3] <- gettext("Skip blank lines")
    tbl[2,4] <- (.$args[['blank.lines.skip']] <- gdroplist(c(FALSE,TRUE), cont=tbl))
    visible(tbl) <- TRUE
    f = gframe(gettext("Attributes"), cont=g)
    tbl <- glayout(cont=f)
#    tbl[1,3] <- "quote"
#    tbl[1,4] <- (.$args[['quote']] <- gedit("\"", cont=tbl))
#    tbl[2,1] <- "Decimal point"
#    tbl[2,2] <- (.$args[["dec"]] <- gdroplist(c(".",","), cont=tbl))
    tbl[1,1] <- gettext("Comment char.")
    tbl[1,2] <- (.$args[['comment.char']] <- gedit("#", cont=tbl))
#    tbl[3,1] <- "NA string"
#    tbl[3,2] <- (.$args[['na.strings']] <- gedit("NA", cont=tbl))

    visible(tbl) <- TRUE

    ## widths is key here

    f = gframe(gettext("Field widths"), cont=g)
    tbl <- glayout(cont=f)
    tbl[1,1] <- gettext("widths")
    tbl[1,2] <- (.$args[["widths"]] <- gedit(paste("c(",nchar(readLines(.$filename,n=1)),")",collapse=""), coerce.with=svalue,cont=tbl))
    visible(tbl) <- TRUE


    makePreview = function(...) {
      ## read in
      l <- lapply(.$args, svalue)
      l$nrows = 10
      df= try(do.call(.$FUN,l), silent=TRUE)
      if(!inherits(df,"try-error")) {
        delete(.$og,.$ig)
        .$ig <- ggroup(horizontal=FALSE, cont=.$og, expand=TRUE)
        tmp <- gdf(df,cont=.$ig) ## get rownames
##         enabled(tmp) <- FALSE ## too faint
      } else {
        cat(gettext("Error:"),df,"\n")
      }
    }

    ## do names?
    f = gframe(gettext("preview"), cont=g,expand=TRUE)
    .$og = ggroup(cont=f, expand=TRUE)
    .$ig = ggroup(cont=.$og, expand=TRUE)                # to be deleted
    makePreview()

    ## now add handler
    sapply(.$args, function(i) addHandlerChanged(i,handler = makePreview))

  }
  GUI$read_DIF = function(.) {
    .$FUN = "read.DIF"
    .$args = list(file = gedit(.$filename))

    g = ggroup(horizontal=FALSE, cont=.$container)
    glabel(paste(gettext("Read"),basename(.$filename),collapse=" "), cont=g)

    tbl <- glayout(cont=g)
    tbl[1,1] <- .$AssignToText
    tbl[1,2] <- (.$varName <- gedit("X", cont=tbl))
    .$varName[] <- ls(envir=.GlobalEnv)
    visible(tbl) <- TRUE

         
    f= gframe(gettext("Import"), cont=g)
    tbl <- glayout(cont=f)
    tbl[1,1] <- gettext("Header")
    tbl[1,2] <- (.$args[['header']] <- gdroplist(c(FALSE,TRUE), cont=tbl))
    tbl[2,1] <- gettext("Skip lines")
    tbl[2,2] <- (.$args[["skip"]] <- gspinbutton(0,1000, cont=tbl))
    tbl[2,3] <- gettext("Skip blank lines")
    tbl[2,4] <- (.$args[['blank.lines.skip']] <- gdroplist(c(FALSE,TRUE), cont=tbl))
    tbl[3,1] <- gettext("NA string")
    tbl[3,2] <- (.$args[['na.strings']] <- gedit("NA", cont=tbl))
    tbl[3,3] <- gettext("Strings as factors")
    tbl[3,4] <- (.$args[['stringsAsFactors']] <- gdroplist(c(TRUE,FALSE),cont=tbl))
    visible(tbl) <- TRUE


    makePreview = function(...) {
      ## read in
      l <- lapply(.$args, svalue)
      l$nrows = 10
      df= try(do.call(.$FUN,l), silent=TRUE)
      if(!inherits(df,"try-error")) {
        delete(.$og,.$ig)
        .$ig <- ggroup(horizontal=FALSE, cont=.$og, expand=TRUE)
        tmp <- gdf(df,cont=.$ig) ## get rownames
##         enabled(tmp) <- FALSE ## too faint
      } else {
        cat(gettext("Error:"),df,"\n")
      }
    }

    ## do names?
    f = gframe(gettext("preview"), cont=g, expand=TRUE)
    .$og = ggroup(cont=f, expand=TRUE)
    .$ig = ggroup(cont=.$og, expand=TRUE)                # to be deleted
    makePreview()

    ## now add handler
    sapply(.$args, function(i) addHandlerChanged(i,handler = makePreview))

  }    

  GUI$read_foreign = function(.,type) {
    .$FUN = paste("read.",type,sep="",collapse="")
    .$args = list(file=gedit(.$filename)) # all have file as first arg


    fileType = names(.fileExtensions)[sapply(.fileExtensions,function(i) .$ext %in% i)]
        ## strip s
    g = ggroup(horizontal=FALSE, cont=.$container)

    glabel(paste(gettext("Read"),basename(.$filename),gettext("as"),popchar(fileType),collapse=" "),
           cont=g)
    tbl = glayout(cont=g)
    tbl[1,1] <- .$AssignToText
    tbl[1,2] <- (.$varName <- gedit("X", cont=tbl))
    .$varName[] <- ls(envir=.GlobalEnv)

    fmls = formals(get(.$FUN))
    nfmls = names(fmls)
    n <- length(nfmls)
    ## add extra arguments without thinking too much
    if(n > 1) {
      for(i in 2:n) {
        tbl[i,1] <- nfmls[i]
        tbl[i,2] <- (.$args[[nfmls[i]]] <-
                     gedit(fmls[[i]], cont=tbl,
                           coerce.with = paste("as.",class(fmls[[i]]),sep="", collapse="")
                           ))
        
      }
    }
    
    visible(tbl) <- TRUE

  }

  ## show GUI$show()
  GUI$show()
}
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/menus.R"
### Define the main menu here



pmg.menu = list()
pmg.menu$File$"Source file.."$handler =
  function(h,...) gfile("Source file",type="open", action="source")
pmg.menu$File$"Source file.."$icon="file"
pmg.menu$File$"Save Workspace..."$handler =
  function(h,...) gfile("Save workspace",type="save", action="save.image")
pmg.menu$File$"Save Workspace..."$icon = "save"
pmg.menu$File$"Restore Workspace"$handler =
  function(h, ...) gfile("Restore workspace",type="open", action="load")
pmg.menu$File$"Restore Workspace"$icon = "revert-to-saved"
pmg.menu$File$"Load package..."$handler =
  function(h,...) pmg.loadPackages()
pmg.menu$File$"Install CRAN package..."$handler =
  function(h,...) pmg.installCRANPackage()
pmg.menu$File$"Install CRAN package..."$icon = "network"
pmg.menu$File$"Install local package..."$handler =
  function(h,...) {
    old = options("repos")$repos; options("repos"=NULL);
    gfile("Select a package file...","open",action="install.packages",
          filter=   list(
            "tar.gz files"=list(
              patterns=c("*.tgz","*.tar.gz")
              ),
            "zip files"=list(
              patterns=c("*.zip")
              ),
            "All files"=list(
              patterns=c("*")
              )
            )
          )
    options("repos"=old)
  }
pmg.menu$File$"Install local package..."$icon = "file"
pmg.menu$File$"Set working directory..."$handler =
  function(h,...) gfile("Select a directory","selectdir",action="setwd")
pmg.menu$File$"Set working directory..."$icon = "directory"

pmg.menu$File$"pmg options..."$handler =
  function(h,...) pmg.options()
pmg.menu$File$"pmg options..."$icon = "preferences"
pmg.menu$File$"View window list"$handler = function(h,...) pmgWC$show()
pmg.menu$File$"Exit pmg"$handler =
  function(h,...)  {
    dispose(pmg.dialogs.window)
    assignInNamespace("pmg.dialogs.window", NULL,"pmg")
    pmg.closeAll()
  }
pmg.menu$File$"Exit pmg"$icon ="quit"
##
##
pmg.menu$Data$browseEnv$handler =
  function(h,...) browseEnv()
pmg.menu$Data$"Load data set..."$handler =
  function(h,...) pmg.viewDataSets()
pmg.menu$Data$"Import data set..."$handler =
  function(h,...) pmg.specifyFileForImport();
pmg.menu$Data$"Write data as CSV file..."$handler =
  function(h,...) pmg.gw(write.csv.list)
#pmg.menu$Data$"Import data set..."$"import table..."$handler =
#  function(h,...) pmg.gw(read.table.list)
#pmg.menu$Data$"Import data set..."$"import csv file..."$handler =
#  function(h,...) pmg.gw(read.csv.list)
#pmg.menu$Data$"Import data set..."$"import fwf file..."$handler =
#  function(h,...) pmg.gw(read.fwf.list)
## dynamic
pmg.menu$Data$"Dynamic summaries"$handler =
  function(h,...) dSummaryDialog()
pmg.menu$Data$"Dynamic summaries"$icon = "execute"
pmg.menu$Data$"Univariate summaries"$table$handler =
  function(h,...) pmg.gw(table.list)
pmg.menu$Data$"Univariate summaries"$"stem and leaf"$handler =
  function(h,...) pmg.gw(stem.list)
pmg.menu$Data$"Univariate summaries"$"summary"$handler =
  function(h,...) pmg.gw(summary.list)
pmg.menu$Data$"Univariate summaries"$"summary"$icon = "info"
pmg.menu$Data$"Univariate summaries"$mean$handler =
  function(h,...) pmg.gw(mean.list)
pmg.menu$Data$"Univariate summaries"$median$handler =
  function(h,...) pmg.gw(median.list)
pmg.menu$Data$"Univariate summaries"$"standard deviation"$handler =
  function(h,...) pmg.gw(sd.list)
pmg.menu$Data$"Univariate summaries"$IQR$handler =
  function(h,...) pmg.gw(IQR.list)
pmg.menu$Data$"Univariate summaries"$mad$handler =
  function(h,...) pmg.gw(mad.list)
pmg.menu$Data$"Univariate summaries"$quantiles$handler =
  function(h,...) pmg.add(quantileWidget(),label="quantile()") # add here
pmg.menu$Data$"Univariate summaries"$skewness$handler =
  function(h,...) pmg.gw(skewnessList)
pmg.menu$Data$"Univariate summaries"$kurtosis$handler =
  function(h,...) pmg.gw(kurtosisList)
##
pmg.menu$Data$"Bivariate summaries"$correlation$handler =
  function(h,...) pmg.gw(cor.list)
pmg.menu$Data$"Bivariate summaries"$"Cross tabulation"$handler =
  function(h,...) pmg.gw(xtabs.list)
##
pmg.menu$Data$"Random data"$"Cumulative Probabilities"$handler = function(h,...) 
  add(pmg.dialog.notebook,dpqrfuncs(type="p"),label="p funcs")
pmg.menu$Data$"Random data"$"Probabilities"$handler = function(h,...) 
  add(pmg.dialog.notebook,dpqrfuncs(type="d"),label="d funcs")
pmg.menu$Data$"Random data"$Quantiles$handler = function(h,...) 
  add(pmg.dialog.notebook,dpqrfuncs(type="q"),label="q funcs")
pmg.menu$Data$"Random data"$"Random samples"$handler = function(h,...) 
  add(pmg.dialog.notebook,dpqrfuncs(type="r"),label="r funcs")


pmg.menu$Data$"Random data"$"Sample"$handler =
  function(h,...) pmg.gw(sample.list)
##

##########
## Simulation. What else?
pmg.menu$Data$Simulation$"Repeat trials"$handler = function(h,...) {
  add(pmg.dialog.notebook, repeatTrialsGUI(), label = "Repeat trials")
}




## Manipulate
if("reshape" %in% .packages(TRUE)) {
  pmg.menu$Data$"Manipulate"$reshape$melt$handler = function(h,...) pmg.meltGUI()
  pmg.menu$Data$"Manipulate"$reshape$cast$handler = function(h,...) pmg.castGUI()
}
#pmg.menu$Data$"Manipulate"$"subset"$handler =
#  function(h,...) pmg.gw(subset.list)
pmg.menu$Data$"Manipulate"$"subset"$handler =
  function(h,...) add(pmg.dialog.notebook,pmg.subset.dialog(),label="subset()")
pmg.menu$Data$"Manipulate"$"subset"$icon = "subset"
pmg.menu$Data$"Manipulate"$"subset"$handler =
  function(h,...) add(pmg.dialog.notebook,pmg.subset.dialog(),label="subset()")
pmg.menu$Data$"Manipulate"$"stack"$handler =
  function(h,...) pmg.gw(stack.list)
pmg.menu$Data$"Manipulate"$"unstack"$handler =
  function(h,...) pmg.gw(unstack.list)
pmg.menu$Data$"Manipulate"$"Edit data frame properties"$handler =
  function(h,...) add(pmg.dialog.notebook,pmg.edit.dataframe.properties.dialog(),label="edit properties")
pmg.menu$Data$"Manipulate"$"Edit data frame properties"$icon = "properties"
##
pmg.menu$Data$"Coerce"$"as.numeric"$handler =
  function(h,...) pmg.gw(as.numeric.list)
pmg.menu$Data$"Coerce"$"as.character"$handler =
  function(h,...) pmg.gw(as.character.list)
pmg.menu$Data$"Coerce"$"as.data.frame"$handler =
  function(h,...) pmg.gw(as.data.frame.list)
pmg.menu$Data$"Coerce"$"as.matrix"$handler =
  function(h,...) pmg.gw(as.matrix.list)
pmg.menu$Data$"Coerce"$"matrix"$handler =
  function(h,...) pmg.gw(matrix.list)
pmg.menu$Data$"Coerce"$"groupedData"$handler =
  function(h,...) pmg.gw(groupedData.list)
pmg.menu$Data$"Coerce"$"factor"$handler =
  function(h,...) pmg.gw(factor.list)
##
## Plots
## Dynamic widget
pmg.menu$Plots$"Lattice explorer"$handler = function(h,...) {
  dLatticeExplorer(container=pmgWC$new("Lattice explorer", v=T))
}
pmg.menu$Plots$"Lattice explorer"$icon = "execute"
###
pmg.menu$Plots$"Set plot parameters"$Setup$handler =
  function(h,...) pmg.gw(par.setup.list)
pmg.menu$Plots$"Set plot parameters"$Setup$icon = "preferences"
pmg.menu$Plots$"Set plot parameters"$Axes$handler =
  function(h,...) pmg.gw(par.axes.list)
pmg.menu$Plots$"Set plot parameters"$Axes$icon = "preferences"
pmg.menu$Plots$"Set plot parameters"$Colors$handler =
  function(h,...) pmg.gw(par.colors.list)
pmg.menu$Plots$"Set plot parameters"$Colors$icon = "preferences"
pmg.menu$Plots$"Set plot parameters"$Fonts$handler =
  function(h,...) pmg.gw(par.fonts.list)
pmg.menu$Plots$"Set plot parameters"$Fonts$icon = "preferences"
pmg.menu$Plots$"Set plot parameters"$"Number of figures"$handler =
  function(h,...) pmg.gw(par.nofigures.list)
pmg.menu$Plots$"Set plot parameters"$"Number of figures"$icon = "preferences"

##
pmg.menu$Plots$univariate$"barplot"$handler = 
  function(h,...) pmg.gw(barplot.list)
pmg.menu$Plots$univariate$"barplot"$icon="barplot"
pmg.menu$Plots$univariate$"piechart"$handler = 
  function(h,...) pmg.gw(piechart.list)
pmg.menu$Plots$univariate$"boxplot"$handler = 
  function(h,...) pmg.gw(univariate.boxplot.list)
pmg.menu$Plots$univariate$"boxplot"$icon = "boxplot"
pmg.menu$Plots$univariate$"histogram"$handler = 
  function(h,...) pmg.gw(hist.list)
pmg.menu$Plots$univariate$"histogram"$icon ="hist"
pmg.menu$Plots$univariate$"density plot"$handler = 
  function(h,...) pmg.gw(densityplot.list)
pmg.menu$Plots$univariate$"quantile-normal plot"$handler = 
  function(h,...) pmg.gw(qqnorm.list)
pmg.menu$Plots$univariate$"stripchart"$handler = 
  function(h,...) pmg.gw(stripchart.list)
pmg.menu$Plots$univariate$"dotchart"$handler = 
  function(h,...) pmg.gw(dotchart.list)
pmg.menu$Plots$univariate$"ecdf"$handler = 
  function(h,...) pmg.gw(ecdf.list)
##
pmg.menu$Plots$bivariate$"boxplot"$handler = 
  function(h,...) pmg.gw(bivariate.boxplot.list)
pmg.menu$Plots$bivariate$"boxplot"$icon = "boxplot"
pmg.menu$Plots$bivariate$"scatterplot"$handler = 
  function(h,...) pmg.gw(scatterplot.list)
pmg.menu$Plots$bivariate$"scatterplot"$icon = "points"
pmg.menu$Plots$bivariate$"sunflower plot"$handler = 
  function(h,...) pmg.gw(sunflower.list)
pmg.menu$Plots$bivariate$"quantile-quantile plot"$handler = 
  function(h,...) pmg.gw(qqplot.list)
##
pmg.menu$Plots$multivariate$"plot"$handler = 
  function(h,...) pmg.gw(scatterplot.model.list)
pmg.menu$Plots$multivariate$"plot"$icon = "plot"
pmg.menu$Plots$multivariate$"boxplot"$handler = 
  function(h,...) pmg.gw(model.boxplot.list)
pmg.menu$Plots$multivariate$"boxplot"$icon = "boxplot"
pmg.menu$Plots$multivariate$"pairs plot"$handler = 
  function(h,...) pmg.gw(pairs.list)
##
pmg.menu$Plots$"Lattice graphics"$"xyplot"$handler = 
  function(h,...) pmg.gw(xyplot.list)
pmg.menu$Plots$"Lattice graphics"$"dotplot"$handler = 
  function(h,...) pmg.gw(dotplot.list)
pmg.menu$Plots$"Lattice graphics"$"barchart"$handler = 
  function(h,...) pmg.gw(barchart.list)
pmg.menu$Plots$"Lattice graphics"$"stripplot"$handler = 
  function(h,...) pmg.gw(stripplot.list)
pmg.menu$Plots$"Lattice graphics"$"bwplot"$handler = 
  function(h,...) pmg.gw(bwplot.list)
##
pmg.menu$Plots$"Add to graphic"$"points"$handler = 
  function(h,...) pmg.gw(add.points.list)
pmg.menu$Plots$"Add to graphic"$"points"$icon = "points"
pmg.menu$Plots$"Add to graphic"$"lines"$handler = 
  function(h,...) pmg.gw(add.lines.list)
pmg.menu$Plots$"Add to graphic"$"lines"$icon = "lines"
pmg.menu$Plots$"Add to graphic"$"density"$handler = 
  function(h,...) pmg.gw(add.density.list)
pmg.menu$Plots$"Add to graphic"$"curve"$handler = 
  function(h,...) pmg.gw(add.curve.list)
pmg.menu$Plots$"Add to graphic"$"curve"$icon = "curve"
pmg.menu$Plots$"Add to graphic"$"rug"$handler = 
  function(h,...) pmg.gw(rug.list)
pmg.menu$Plots$"Add to graphic"$"title"$handler = 
  function(h,...) pmg.gw(add.title.list)


## iplots conditionally
if("iplots" %in% .packages(TRUE)) {
  pmg.menu$Plots$"iplots"$handler = function(...) {
    pmg.iplots()
  }
}

## Add back in, bu this is causing crashes!
## ## qqplot2 conditionally
## if("ggplot2" %in% .packages(TRUE)) {
##   pmg.menu$Plots$"qplot"$handler = function(...) {
##     qplotGUI(container=pmg.dialog.notebook, label = "qplot()")
##   }
## }

pmg.menu$Plots$"Teaching demos"$handler =
  function(h,...) pmg.teachingDemos()
###
### tests
pmg.menu$Tests$"Dynamic tests"$handler = function(h,...) {
  dTestsDialog()
}
pmg.menu$Tests$"Dynamic tests"$icon="execute"
##
pmg.menu$Tests$centers$"t.test"$handler =
  function(h,...) pmg.gw(t.test.list)
pmg.menu$Tests$centers$"t.test (summarized data)"$handler =
  function(h,...) pmg.gw(t.test.summaries.list)
pmg.menu$Tests$centers$"wilcox.test"$handler =
  function(h,...) pmg.gw(wilcox.test.list)
pmg.menu$Tests$centers$"oneway.test"$handler =
  function(h,...) pmg.gw(oneway.test.list)
pmg.menu$Tests$centers$"kruskal.test"$handler =
  function(h,...) pmg.gw(kruskal.test.list)
#
pmg.menu$Tests$scales$"var.test"$handler =
  function(h,...) pmg.gw(var.test.list)
pmg.menu$Tests$scales$"ansari.test"$handler =
  function(h,...) pmg.gw(ansari.test.list)
pmg.menu$Tests$scales$"bartlett.test"$handler =
  function(h,...) pmg.gw(bartlett.test.list)
pmg.menu$Tests$scales$"fligner.test"$handler =
  function(h,...) pmg.gw(fligner.test.list)
#
pmg.menu$Tests$shape$"ks.test"$handler =
  function(h,...) pmg.gw(ks.test.list)
pmg.menu$Tests$shape$"shapiro.test"$handler =
  function(h,...) pmg.gw(shapiro.test.list)
#
pmg.menu$Tests$proportion$"prop.test"$handler =
  function(h,...) pmg.gw(prop.test.list)
pmg.menu$Tests$proportion$"binom.test"$handler =
  function(h,...) pmg.gw(binom.test.list)
#
pmg.menu$Tests$counts$"chisq.test"$handler =
  function(h,...) pmg.gw(chisq.test.list)
pmg.menu$Tests$counts$"mantelhaen.test"$handler =
  function(h,...) pmg.gw(mantelhaen.test.list)
pmg.menu$Tests$counts$"mcnemar.test"$handler =
  function(h,...) pmg.gw(mcnemar.test.list)
#
pmg.menu$Tests$correlation$"cor.test"$handler =
  function(h,...) pmg.gw(cor.test.list)
#

###
pmg.menu$Models$"Dynamic models"$handler = function(h,...) {
  dModelsDialog()
}
pmg.menu$Models$"Dynamic models"$icon="execute"
##
pmg.menu$Models$Regression$"lm"$handler =
  function(h,...) pmg.gw(lm.list)
pmg.menu$Models$Regression$"lqs"$handler =
  function(h,...) pmg.gw(lqs.list)
pmg.menu$Models$Regression$"glm"$handler =
  function(h,...) pmg.gw(glm.list)
#
pmg.menu$Models$ANOVA$"aov"$handler =
  function(h,...) pmg.gw(aov.list)
pmg.menu$Models$ANOVA$"anova"$handler =
  function(h,...) pmg.gw(anova.list)
#
pmg.menu$Models$"Mixed effects"$"gls"$handler =
  function(h,...) pmg.gw(gls.list)
pmg.menu$Models$"Mixed effects"$"lmList"$handler =
  function(h,...) pmg.gw(lmList.list)
pmg.menu$Models$"Mixed effects"$"lme"$handler =
  function(h,...) pmg.gw(lme.list)
#
pmg.menu$Models$Diagnostics$"plot.lm"$handler =
  function(h,...) pmg.gw(lm.diagnostics.list)
pmg.menu$Models$Diagnostics$"plot.lme"$handler =
  function(h,...) pmg.gw(plot.lme.diagnostics.list)
pmg.menu$Models$Diagnostics$"qqnorm.lme"$handler =
  function(h,...) pmg.gw(qqnorm.lme.diagnostics.list)
pmg.menu$Models$Diagnostics$"pairs.lme"$handler =
  function(h,...) pmg.gw(pairs.lme.diagnostics.list)
#
pmg.menu$Models$"Model selection"$"anova"$handler =
  function(h,...) pmg.gw(anova.list)
pmg.menu$Models$"Model selection"$"stepAIC"$handler =
  function(h,...) pmg.gw(stepAIC.list)



## help menu
## help menu is separate
## Question: do I want popup dialogs here or integrated in framework?
help.menu=list()
help.menu$Help$"About R"$handler =
  function(h,...) add(pmg.dialog.notebook,pmg.about.R(),label = "About R")
help.menu$Help$"About PMG"$handler =
  function(h,...) add(pmg.dialog.notebook,pmg.about(),label = "About P M G")
##pmg.about(container=pmgWC$new(v=TRUE))
help.menu$Help$"About PMG"$icon="about"
help.menu$Help$"R helpbrowser"$handler =
  function(h,...) {
    if(is.null(pmg.helpBrowser.window) ||
       is.invalid(pmg.helpBrowser.window)) {
      assignInNamespace("pmg.helpBrowser.window", ghelpbrowser(),"pmg")
    } else {
      focus(pmg.helpBrowser.window) <- TRUE # will this work
    }
  }
help.menu$Help$"R Site Search"$handler = function(h,...) RSiteSearch.Dialog()
help.menu$Help$"View vignettes"$handler = function(h,...) viewVignettes.Dialog()
help.menu$Help$"View demos"$handler = function(h,...) viewDemos.Dialog()
help.menu$Help$"View P M G vignette"$handler = function(h,...) print(vignette("pmg",package="pmg"))
## help.menu$Help$"PMG manual"$handler =
##   function(h,...) vignette("pmg")
## help.menu$Help$"Help on topic..."$handler =
##   function(h,...) pmg.helpBrowser()
## help.menu$Help$"Run examples from..."$handler =
##   function(h,...) pmg.examplesBrowser()
## help.menu$Help$"Run demos from..."$handler =
##   function(h,...) pmg.demosBrowser()
## help.menu$Help$"Search web for answers..."$handler =
##   function(h, ...) pmg.RSiteSearch()



#pmg.gw = function(lst) {
#  widget = ggenericwidget(lst, container=NULL, cli=cli)
#  win = gwindow(lst$title, v=T)
#  group = ggroup(container=win)
#  gvarbrowser(container=group)
#  add(group, widget, expand=TRUE)
#}


##################################################
#win = gwindow("P M G", v=T)
#group = ggroup(horizontal=FALSE, container=win)
#m = gmenu(menu, container=group)
#cli = icli(container=group)
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/misc.R"
## some miscellaneous functions
## Use this to filter by type
## knownTypes in common
### Use this for filtering by (gvarbrowser, gvarbrowsertree)
.datasets = c(
  "numeric","logical","factor","character",
  "data.frame","matrix","list",
  "table","xtabs",
  "nfnGroupedData","nffGroupedData","nmGroupedData"
  )
.models = c("lm","glm","lqs","aov","anova",
    "lme","lmList","gls",
  "ar","arma","arima0","fGARCH","fAPARCH"
    )
.ts = c("ts", "mts", "timeSeries", "its", "zoo")
.functions=c("function")
.plots = c("recordedplot")

knownTypes = list(
  "data sets and models"=c(.datasets, .models, .ts),
  "data sets"= .datasets,
  "model objects" = .models,
  "time series objects" = .ts,
  "functions"=.functions,
  "saved plots" = .plots,
  "all" = NULL
  )

## list of some type
lsType = function(type, envir=.GlobalEnv) {
  x = with(.GlobalEnv, sapply(ls(), function(i) class(get(i))))
  objects = names(x)[sapply(x, function(i) any(i %in% type))]
  return(objects)
}
lsDatasets = function(envir=.GlobalEnv())  lsType(.datasets, envir)
lsModels = function(envir=.GlobalEnv())  lsType(.models, envir)
lsTs = function(envir=.GlobalEnv())  lsType(.ts, envir)
lsFunctions = function(envir=.GlobalEnv())  lsType(.functions, envir)

###  These should be in gWidgets or gWidgetsRGtk2, but arent
## what type of object is thixs and a size
str2 <- function(obj) {
  md <- mode(obj)
  if (is.matrix(obj))  md <- "matrix"
  obj.class <- oldClass(obj)
  if (!is.null(obj.class)) {
    md <- obj.class[1]
  }
  return(md)
}




##################################################
##
## make a fancy summary function for showing on double click
## in varbrowser
## make generic, but not needed
pmgSummary = function(obj,...) UseMethod("pmgSummary")
pmgSummary.default = function(obj, ...) {
  ## what is object?
  objName = deparse(substitute(obj))

  if(is.character(obj) && length(obj) == 1) {
    ## assume it is a string containing object
    objName = obj
    obj = svalue(obj)

  }

  
  group = ggroup(horizontal = FALSE,...)

  ## should I export this function?
  icon = stockIconFromClass(class(obj))
  add(group, gimage(icon, dirname="stock", size="DIALOG"))
  table = glayout(adjust="left")
  add(group, table)

  table[1,1] = glabel("<b>Name:</b>", markup=TRUE)
  table[1,2] = glabel(objName)

  table[2,1] = glabel("<b>Kind:</b> ", markup=TRUE)
  table[2,2] = glabel(paste(class(obj),sep="",collapse=", "))


  table[3,1] = glabel("<b>Size:</b>",markup=TRUE)
  if(!is.function(obj)) {
    theSize = str1(obj)$dim.field
    table[3,2] = glabel(theSize)
  } else {
    table[3,2] = glabel("NA")
  }

  stamp = Timestamp(obj)
  if(!is.na(stamp)) {
    table[4,1] = glabel("<b>Last modified:</b>", markup=TRUE)
    table[4,2] = glabel(format(as.Date(stamp), "%B %d, %Y"))
  }

  table[5,1] = glabel("<b>Preview:</b>", markup=TRUE)
  theValue = capture.output(eval(obj))
  if(length(theValue) > 10)
    theValue = c(theValue[1:10],"... 8< snipped >8 ...")
  theHead = gtext(font.attr=c("monospace"))
  add(theHead,theValue)
  enabled(theHead) <- FALSE
  add(group, theHead, expand=TRUE)
    
  visible(table) <- TRUE

  return(group)
}


## Push and Pop -- for convenience
Push = function(v,d) c(v,d)
Pop = function(v) ifelse(length(v) > 1, v[-length(v)], NA)


### is functions
is.RGtkObject = function(obj) {
  is(obj,"RGtkObject") 
}

is.guiWidget = function(obj) {
  is(obj,"guiWidget")
}
is.gWidget = function(obj) {
  is(obj,"gWidgetRGtk")
}
is.gWindow = function(obj) {
  is(obj,"gWindowRGtk")
}
is.gComponent = function(obj) {
  is(obj,"gComponentRGtk")
}
is.gContainer = function(obj) {
  is(obj,"gContainer")
}

is.gImage = function(obj) {
  is(obj,"gImageRGtk")
}
is.gLabel = function(obj) {
  is(obj,"gLabelRGtk") 
}

is.gMenu = function(obj) {
  is(obj,"gMenuRGtk") 
}
is.gEditDataFrame=function(obj) {
  stop("deprecated, use is.gGrid")
}
is.gGrid = function(obj) {
  is(obj,"gGridRGtk")
}

is.invalid = function(obj) {
  while(!is.RGtkObject(obj))
    obj = obj@block
  ifelse("<invalid>" %in% class(obj), TRUE, FALSE)
}
## used to check output 
is.empty = function(obj) {
  if(is.null(obj) || is.na(obj) || obj == "") {
    return(TRUE)
  } else {
    return(FALSE)
  }
}


## for showing only possible values
is.dataframelike = function(obj) {
  if(is.data.frame(obj) || is.matrix(obj) ||
     is.numeric(obj) || is.logical(obj) ||
     is.factor(obj)) {
    return(TRUE)
  } else {
    return(FALSE)
  }
}

## check if a gtkTreeViewCOlumn, make no GTK language
is.gdataframecolumn = function(obj) {
  ## is this making windows bug out?
  if(class(obj)[1] == "GtkTreeViewColumn")
    return(TRUE)
  else
    return(FALSE)
}

## Function to convert back and forth between R classes and GObject classes
RtoGObjectConversion = function(obj) {
  if("gComponent" %in% class(obj)) return("GObject")
  if(is.list(obj)) return("GObject")
  
  Klasse = class(obj)[1]                # silly name?
  switch(Klasse,
         "integer"="gint",
         "numeric"="gdouble",
         "gtk"="GObject",
         "logical" = "gboolean",
         "gchararray"
         )
}


### these are used by gvarbrowser
## This is from browseEnv in base
## what type of object is thixs and a size
str1 <- function(obj) {
  md <- mode(obj)
  lg <- length(obj)
  objdim <- dim(obj)
  if (length(objdim) == 0) 
    dim.field <- paste("length:", lg)
  else {
    dim.field <- "dim:"
    for (i in 1:length(objdim)) dim.field <- paste(dim.field, 
                                                   objdim[i])
    if (is.matrix(obj)) 
      md <- "matrix"
  }
  obj.class <- oldClass(obj)
  if (!is.null(obj.class)) {
    md <- obj.class[1]
    if (inherits(obj, "factor")) 
      dim.field <- paste("levels:", length(levels(obj)))
  }
  list( type = md, dim.field = dim.field)
}

## what type of object is thixs and a size
str2 <- function(obj) {
  md <- mode(obj)
  if (is.matrix(obj))  md <- "matrix"
  obj.class <- oldClass(obj)
  if (!is.null(obj.class)) {
    md <- obj.class[1]
  }
  return(md)
}

## untaint a variable name so that $ can be used
untaintName = function(objName) {
  if (length(grep(" |\\+|\\-|\\*|\\/\\(|\\[|\\:",objName)) > 0) {
    objName=Paste("\"",objName,"\"")
  }
  return(objName)
}

## try to stip off data frame stuff in fron to DND target
findDataParent = function(x) {
  child = sub(".*]]","",x)
  child = sub(".*\\$","",child)
  parent = sub(Paste(child,"$"),"",x)
  parent = sub("\\$$","",parent)
  return(list(child=child,parent=parent))
}


## basically repeat findDataParent until no parent
findRootObject = function(x) {
  x = sub("\\[\\[.*","",x)
  x = sub("\\$.*","", x)
  return(x)
}


## get does not work with name$component, this gets around that
## returns NULL if not available
getObjectFromString = function(string="", envir=.GlobalEnv) {
  tmp = try(get(string, envir), silent = TRUE)
  if(!inherits(tmp, "try-error")) return(tmp)
  
  tmp = try(rpel(string,envir), silent=TRUE)
  if(!inherits(tmp, "try-error"))  return(tmp)

  ## out of chances
  return(NULL)
}



## get the names of the object, if available (datastores)
getNamesofObject = function(string="") {
  ## if empty string, get variables in .GlobalEnv
  if(string == "") {
    ## return objects of certain type
    objects = getObjectsWithType(root=NULL, filter=knownTypes[['data sets']])
    return(unlist(objects$Name))
  } 
  obj = getObjectFromString(string)
  if(!is.null(obj)) {
    if(is.list(obj)) {
      return(names(obj))
    } else if(is.matrix(obj)) {
      return(colnames(obj))
    } else{
      return(NULL)
    }
  } else {
    return(NULL)
  }
}

## a function to get objects and their types
## filter is a vector of classes
getObjectsWithType = function(root=NULL, filter = NULL, envir=.GlobalEnv) {

  if(is.null(root)) {
    objects = ls(envir=envir)
  } else {
    string = Paste("with(",root,",ls())")
    objects = try(rpel(string,envir=envir), silent=TRUE)
  }
  ## objects is character vector of components of root.
  badnames = grep("[[<-]|\\*",objects)
  if(length(badnames) > 0)
    objects = objects[-badnames]

  objectsWithRoot = sapply(objects,function(i) makeObjectName(root,i))

  
  type = sapply(objectsWithRoot, function(i) {
    string = Paste("str2(",i,")")
    rpel(string, envir=envir)
  })

  objects = data.frame(Name=I(objects),Type=I(type))

  ## filter
  if(!is.null(filter))
    objects = objects[type %in% filter,]

  return(objects)
  
  
}


## Find the name of the object by pasting toghther the pieces
## better to do name$name, but value may be a numeric
makeObjectName = function(root,value) {
  if(is.null(root)) return(untaintName(value))

  ## now decide between $ and [[]]
  if(value == make.names(value)) {
    return(Paste(root,"$",untaintName(value)))
  } else {
    return(Paste(root,"[['",value,"']]"))
  }
}

Paste = function(..., sep="", collapse="") {
  x = unlist(list(...))
  x = x[!is.na(x)]
  x = x[x != "NA"]
  paste(x, sep=sep, collapse=collapse)
}

stripWhiteSpace = function(str) {
  sub('[[:space:]]+$', '', str) ## from ?gsub
  sub('^[[:space:]]+', '', str) ## from ?gsub
  return(str)
}
## ReadParseEvaL -- saves typing
rpel = function(string, envir=.GlobalEnv) {
  eval(parse(text=string), envir=envir)
}



"Timestamp<-" <- function(obj,value) {
  currentStamp = Timestamp(obj)
  currentStamp = c(currentStamp, timestamp=as.character(Sys.time()),comment=value)
  comment(obj) <- currentStamp
  return(obj)
}

Timestamp = function(obj,k=1) {
  currentComment= comment(obj)
  allStamps =comment(obj)[names(comment(obj)) %in% "timestamp"]
  n = length(allStamps)
  if(n > 0)
    return(allStamps[(max(1,n+1-k)):n])
  else
    return(NA)
}



##################################################
## define skewness and kurtosis
skewness = function(x, na.rm=TRUE,...) UseMethod("skewness")
### FROM http://finzi.psych.upenn.edu/R/Rhelp02a/archive/44065.html
skewness.factor <- function(x, na.rm=TRUE, ...) NA
skewness.character <- skewness.factor
skewness.list = function(x, na.rm=TRUE, ...) sapply(x,skewness)
skewness.data.frame = function(x, na.rm=TRUE, ...) sapply(x,skewness)
skewness.default =  function(x, na.rm=TRUE, ...)  {
  ## Remove NAs:
  if (na.rm) x = x[!is.na(x)]

  ## Warnings:
  if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
    warning("argument is not numeric or logical: returning NA")
    return(as.numeric(NA))}
  
  
  ## Skewness:
  n = length(x)
  if (is.integer(x)) x = as.numeric(x)
  skewness = sum((x-mean(x))^3/sqrt(var(x))^3)/length(x)
  
  ## Return Value:
  skewness
}
kurtosis <- function(x, na.rm=TRUE, ...) UseMethod("kurtosis")
kurtosis.list <- function(x, na.rm=TRUE, ...) sapply(x, kurtosis) # lazy == na.rm?
kurtosis.factor <- function(x, na.rm=TRUE, ...) return(NA)
kurtosis.character <- kurtosis.factor 
kurtosis.data.frame = function(x, na.rm=TRUE, ...) sapply(x, kurtosis)
kurtosis.default = function(x, na.rm=TRUE, ...) {
  ## Remove NAs:
  if (na.rm) x = x[!is.na(x)]
  
  n = length(x)
  if (is.integer(x)) x = as.numeric(x)
  kurtosis = sum((x-mean(x))^4/var(x)^2)/length(x) - 3
                                        
  kurtosis
}

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.R"
## TODO
## * manage the open windows somehow
## * left drop targetes need fixing
## * idlehandler for tree

### globals
## main windows

pmg.helpBrowser.window = NULL
pmg.plotnotebook.window = NULL
pmg.dialogs.window = NULL
pmg.cli.window = NULL

## for interactions
pmg.menuBar = NULL
pmg.toolBar = NULL
pmg.dialog.notebook = NULL
pmg.cli = NULL
pmg.statusBar = NULL

##
pmg.prompt = getOption("prompt")

pmg.window = NULL

###################################################################
##
## Functions to add to pmg 
pmg.help = function(h,...) {
  ## what to call for help page
  ## h$action contains help topic

  ## open helpBrowser if not yet
  ## else we deal with GUI
  if(is.null(pmg.helpBrowser.window) ||
     !is.gWindow(pmg.helpBrowser.window) ||
     is.invalid(pmg.helpBrowser.window)
     ) {

##      pmg.helpBrowser.window <<- ghelpbrowser()
    assignInNamespace("pmg.helpBrowser.window", ghelpbrowser(),"pmg")
  } else {
    focus(pmg.helpBrowser.window) <- TRUE
  }
  ## open page
  add(pmg.helpBrowser.window,label=h$action)
}

## function for generic widget usage
pmg.gw = function(lst, label=NULL) {
  if(!is.list(lst) || is.null(lst$variableTypeExtra)) {
    widget = ggenericwidget(lst, container=NULL, cli=pmg.cli,help.cb = pmg.help)
  } else {
    argList = list(lst=lst,cli = pmg.cli,helphandler=pmg.help, container=NULL)
    tmp = lst$variableTypeExtra ## a list
    argList[[tmp$name]] <- tmp$value
    widget = do.call("ggenericwidget",argList)
  }
  if(is.null(label)) {
    if(is.list(lst))
      label = lst$title
    else
      label = Paste(lst,"()")                         # a character string,
  }

  g = ggroup(use.scrollwindow=TRUE)
  add(g,widget, expand=TRUE)
  add(pmg.dialog.notebook, g, label=label, pageno = 3) # add near beginnign
}

### Add to the dialog notebook
pmg.add = function(widget, label) {
  add(pmg.dialog.notebook, widget, label=label, pageno=3) # add near beginning
}

### add to the menu bar
pmg.addMenubar = function(menulist) {
  add(pmg.menuBar, menulist)
}

pmg.eval = function(command, assignto=NULL) {
  if(!is.null(assignto)) names(command) <- assignto
  svalue(pmg.cli) <- command
}

### -- Not working right now
pmg.closeAll = function() {
  for(i in c(
             "pmg.cli.window","pmg.helpBrowser.window",
             "pmg.plotnotebook.window","pmg.dialogs.window")
      ) {
    window = getFromNamespace(i,"pmg")
    try(dispose(window), silent=TRUE)
    assignInNamespace(i,NULL, "pmg")
  }
}


##################################################
## call with "console" to use console, defaults to GUI
pmg = function(cliType="console", width=850, height=.75*width,
  guiToolkit="RGtk2") {                 # getOption("guiToolkit")
  if(!interactive()) {
    cat("PMG requires an interactive environment\n")
    return()                            # no sense to have GUI if not
  }


  ## sizes
  rightWidth = width*.6                 # notebook, command area
  mainHeight = height*.8                # height without menu, tool bars

  ### which toolkit to load. If there is a gWidgets, then do that, else try pmggWidgetsRGtk
  if(!require(gWidgets)) {
    cat("PMG currently needs gWidgets and gWidgetsRGtk2\n");
    return()
  }
  if(!require(gWidgetsRGtk2)) {
   cat("PMG needs gWidgets and gWidgetsRGtk2\n");
    return()
  } 
  if(guiToolkit != "RGtk2") {
    cat("pmg uses gWidgets and gWidgetsRGtk2, overriding choice of toolkit\n")
  }
  
  options("guiToolkit"="RGtk2")         # must have RGtk2 here
  
  ## what type of cli
  if(cliType != "console")
    cliType = "GUI"

  ## Make a window for pmg.gw to load into
  if(is.null(pmg.dialogs.window) ||
     !is.gWindow(pmg.dialogs.window) ||
     is.invalid(pmg.dialogs.window)
     ) {
    assignInNamespace("pmg.dialogs.window", pmgWC$new("P M G Dialogs", visible=FALSE), "pmg")
    size(pmg.dialogs.window) <- c(width, height)
  } else {
    ## raise window, exit
    return()
  }

  ## Define the main widgets
  assignInNamespace("pmg.menuBar", gmenu(pmg.menu, container=NULL), "pmg")
  assignInNamespace("pmg.dialog.notebook", gnotebook(closebuttons = TRUE,
                                                     dontCloseThese = 1, # was 1:2 before commands area moved
                                                     tearable = FALSE),
                    "pmg"
                    )
  assignInNamespace("pmg.statusBar", gstatusbar("", container=NULL),"pmg")


  ## Main layout
  mainGroup = ggroup(horizontal = FALSE, spacing=0, container=pmg.dialogs.window, expand=TRUE)

  add(mainGroup, pmg.menuBar)
  ## optional menu for user The user menu is a named list, the
  ## top-level names yield the name across the menubar
  if(exists("pmg.user.menu")) {
    for(i in names(pmg.user.menu)) {
      userMenu = gmenu(pmg.user.menu[[i]], name=i)
      add(pmg.menubar, userMenu)
    }
  }

  helpMenu = gmenu(help.menu, name="Help")
  add(pmg.menuBar, helpMenu)
  
  buttonBar = ggroup(spacing=0)
  add(mainGroup, buttonBar)             # toolbar

  bottomGroup = ggroup(horizontal=TRUE)
  add(mainGroup, bottomGroup, expand=TRUE)
  pmg.droparea = ggroup(horizontal=FALSE, container=bottomGroup)
  pmg.varbrowser = gvarbrowser(
    handler = function(h,...) {         # double click handler calls pmgSummary
      value = svalue(pmg.varbrowser)
      add(pmg.dialog.notebook, pmgSummary(value),
          label=Paste("Summary of ",svalue(h$obj)))
    }
    )


  ### How to layout the notebook?
  ### Try with command area below
  ## pg = gpanedgroup(pmg.varbrowser, pmg.dialog.notebook)
  ## put commands on bottom able to be expanded

  commandGroup = gexpandgroup("Command area")
  visible(commandGroup) <- TRUE
  rightPanedGroup = gpanedgroup(pmg.dialog.notebook,commandGroup,horizontal=FALSE)
  pg = gpanedgroup(pmg.varbrowser, rightPanedGroup)
  size(pmg.dialog.notebook) <- c(rightWidth,mainHeight*.67)
  
  add(bottomGroup, pg, expand=TRUE)

  add(mainGroup, pmg.statusBar)
  
  ## add buttons to buttonbar
  ## define list structure
  toolbar = list()
  ## quit
  toolbar$quit$handler = function(h,...) {
    dispose(pmg.dialogs.window)
    assignInNamespace("pmg.dialogs.window", NULL,"pmg")
#    pmgWC$closeAll()
    pmg.closeAll()
  }
  toolbar$quit$icon = "quit"
  ##
  toolbar$tmp1$separator = TRUE         # add line

  ## save workspace
  toolbar$save$handler = function(h,...) {
    gfile("Save workspace",type="save", action="save.image")
  }
  toolbar$save$icon = "save"

  ## plot notebook
  ### XXX This is an issue: cairoDevice needs to be 
##  if(guiToolkit == "RGtk2" && require(cairoDevice)) {
    toolbar$plotnotebook$handler = function(h,...) {
      if(is.null(pmg.plotnotebook.window) ||
         !is.gWindow(pmg.plotnotebook.window) ||
         is.invalid(pmg.plotnotebook.window)
         ) {
        assignInNamespace("pmg.plotnotebook.window", pmgWC$new("P M G plot notebook", visible=TRUE ),"pmg")
        add(pmg.plotnotebook.window, ggraphicsnotebook())
      } else {
        focus(pmg.plotnotebook.window) <- TRUE
      }
    }
    toolbar$plotnotebook$icon = "plot"
##  }

  toolbar$tmp2$separator = TRUE

  
  ## fill these in
##   toolbar$print$handler = function(h,...) print("print")
##   toolbar$print$icon = "print"

  ## help
  toolbar$help$handler = function(h,...) {
    if(class(pmg.helpBrowser.window) != "pmgHelpBrowser")  {
##      pmg.helpBrowser.window <<- ghelpbrowser()
      assignInNamespace("pmg.helpBrowser.window", ghelpbrowser(),"pmg")
    } else {
      ## raise window pmg.helpBrowser.window
      focus(pmg.helpBrowser.window) <- TRUE
    }
  }
  toolbar$help$icon = "help"
  
  ## make the toolbar
  tmp = gtoolbar(toolbar)
  assignInNamespace("pmg.toolBar",tmp,"pmg")
  add(buttonBar, pmg.toolBar, expand=TRUE)

  ##################################################
  ## add drop targets to left side
  ## for quick actions from varbrowser
  editDrop = gimage("edit",dirname="stock",container=pmg.droparea)
  addSpace(pmg.droparea,10);add(pmg.droparea,gseparator());addSpace(pmg.droparea,10)
  plotDrop = gimage("plot",dirname="stock",container=pmg.droparea)
  addSpace(pmg.droparea,10);add(pmg.droparea,gseparator());addSpace(pmg.droparea,10)
  summaryDrop = gimage("info",
    dirname="stock",container=pmg.droparea)
  addSpace(pmg.droparea,10);add(pmg.droparea,gseparator());addSpace(pmg.droparea,10)
  removeDrop = gimage("delete",dirname="stock",container=pmg.droparea)
  addSpring(pmg.droparea)
  
  ## add handlers
  adddroptarget(summaryDrop,handler=function(h,...) {
    svalue(pmg.cli) <-  Paste("summary(",list(h$dropdata),")")
  })
  adddroptarget(plotDrop,handler=function(h,...) {
    svalue(pmg.cli) <- Paste("plot(",list(h$dropdata),")")
  })
  adddroptarget(editDrop,handler=function(h,...) {
    ## don't do this in CLI
    rpel(Paste("fix(",list(h$dropdata),")"))
  })
  adddroptarget(removeDrop,handler=function(h,...) {
    svalue(pmg.cli) <- Paste("rm(",list(h$dropdata),")")
  })


  ## add big page to notebook to give instructions, and fix size of notebook
  useConsole = ifelse(cliType == "console",TRUE, FALSE)
  assignInNamespace("pmg.cli",
                    gcommandline("",width=rightWidth,height=mainHeight*.33,
                                              useConsole=useConsole),"pmg")
  ## put CLI and editing sheet here
  ## This adds to notebook
##   add(pmg.dialog.notebook,pmg.cli,label = "Commands",
##       pageno = 1, override.closebutton = TRUE,
##       tearable = FALSE
##       )
  add(commandGroup, pmg.cli, expand=TRUE)
  
  ## add notebook page for editing data and cli
  ## the hack keeps charaacter not factor
  x = as.numeric(NA);df=data.frame(X1=x)

  pmg.data.frame.viewer.nb = gdfnotebook(tab.pos=1, dontCloseThese=1)
  ## for some reason this gives error message
  ##  add(pmg.data.frame.viewer.nb, gdf(df,do.subset=TRUE), label= "*scratch:1*")

  add(pmg.dialog.notebook, pmg.data.frame.viewer.nb, label = "Data",
      pageno = 2, override.closebutton = TRUE
      )
  
  ## some blurb
  add(pmg.dialog.notebook,pmg.about(),label="About PMG")

  ## Finally, draw window
  visible(pmg.dialogs.window)<-TRUE
}

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.about.R"

checkForUpdatesGUI = function() {
  win = pmgWC$new("Check for updates", visible=FALSE)
  g = ggroup(horizontal = FALSE, cont=win)
  l = glabel(".-.-.-", cont=g, expand=TRUE)
  sb = gstatusbar("Checking for updates", cont=g)
  visible(win) <- TRUE
  
  val = checkForUpdates()
  if(length(val) == 0)
    svalue(l) <- "All the main pmg packages are up to date"
  else
    svalue(l) <- paste("You can upgrade", paste(val,sep=", "),".",sep=" ")
  svalue(sb) <- ""
}

checkForUpdates = function() {
  ## find any packages needing updates

  if(getCranSiteIfNeeded()) {
  
    thePackages = c("pmg","gWidgets","gWidgetsRGtk2","cairoDevice")
    
    oldPackages = old.packages()
    
    updateThese = thePackages[which(thePackages %in% rownames(oldPackages))]
    
    if(length(updateThese) > 0) {
      return(oldPackages[updateThese,"Package"])
    } else {
      return(c())
    }
  } else {
    cat("You need to set a CRAN repository to proceed\n")
  }
  
}

getCranSiteIfNeeded = function() {
  repos = getOption("repos")
  if ("@CRAN@" %in% repos) {
  
    setCRAN <- function(URL) {
      repos = getOption("repos")
      repos["CRAN"] <- gsub("/$", "", URL)
      options(repos=repos)
    }
    
    
    handler = function(h,...) {
      URL <- svalue(tbl) # get value  widget
      cat("Set CRAN site to",URL,"\n")
      setCRAN(URL)       # set URL
    }

    g = ggroup(horizontal = FALSE, cont = NULL)
    glabel("Select a site\nthen click 'OK'", cont=g)
    tbl <- gtable(
                  items=utils:::getCRANmirrors(),
                  chosencol=4,     
                  filter.column=2,
                  container=g,
                  )
    size(tbl) <- c(200,300)
    gbasicdialog(title="Select a CRAN site", widget=g, handler=handler)
  } else {
    return(TRUE)
  }
}

#########################################

pmg.about = function(container=NULL) {

## image is group pmg via www.geom.uiuc.edu/~dpvc
  
  group = ggroup(horizontal=FALSE,container=container)
  size(group) <-  c(500,500)
  theFactsMam = read.dcf(system.file("DESCRIPTION",package="pmg"))
  glabel(Paste(
               "<b> P M G</b>\n",
               "<i>",
               theFactsMam[1,'Title'],
               "</i>\n",
               "Version ",
               theFactsMam[1,"Version"],
               "\n\n",
               theFactsMam[1,'URL'],
               "\n",
               "Comments to pmgRgui@gmail.com\n",
               "\n\n",
               theFactsMam[1,"Author"],
               "\n\n",
               theFactsMam[1,"Description"],
               "\n"
               ), markup=TRUE, container=group)
  addSpring(group, 10)
  gbutton("Check for updates", container = group,
          handler = function(...) checkForUpdatesGUI())
  
  return(group)
}

pmg.about.R = function(container=NULL) {

## image is group pmg via www.geom.uiuc.edu/~dpvc
  
  group = ggroup(horizontal=FALSE,container=container)
  gimage(system.file("images","Rlogo.jpg",package="pmg"),  container=group)
  glabel(paste(
               "<b> R </b>",
               "is a free software environment for statistical\n",
               "computing and graphics.\n\n",
               "<i>http://www.r-project.org</i>\n\n",
               R.version.string,
#               "Version ",
#               paste(R.version$major,R.version$minor,sep="."),
               "\n\n",
               sep=" ", collapse=" "
               ), markup=TRUE, container=group)

  return(group)
}
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.ctestsmenu.R"
#### Classical testse (ctests)
#### This file defines the list that get fed to genericWidget for
#### making dialog

### sample file for t.test.
### abstract so that you can produce these dialogs from a list

## prop.test
prop.test.list = list(
  title = "prop.test()",
  help = "prop.test",
  type = "text",                      # either text or graphic
  variableType = NULL,
  assignto = NULL,
  action = list(
    beginning = "prop.test(",
    ending = ")"
    ),
  arguments = list(
    variables = list(
      x=EMPTY.list,
      n=EMPTY.list
      ),
    hypotheses = list(
      alternative= alternative.list,
      p = list(
        type = "gedit",
        text = "0.5"
        )
      ),
    "CI" = list(
      conf.level = conf.level.list
      )
    )
  )

##binom.test
## prop.test
binom.test.list = list(
  title = "binom.test()",
  help = "binom.test",
  type = "text",                      # either text or graphic
  variableType = NULL,
  assignto = NULL,
  action = list(
    beginning = "binom.test(",
    ending = ")"
    ),
  arguments = list(
    variables = list(
      x=EMPTY.list,
      n=EMPTY.list
      ),
    hypotheses = list(
      alternative= alternative.list,
      p = list(
        type = "gedit",
        text = "0"
        )
      ),
    "CI" = list(
      conf.level = conf.level.list
      )
    )
  )


## t.test
t.test.list = list(
  title = "t.test()",
  help = "t.test",
  type = "text",                      # either text or graphic
  variableType = "bivariate",
  assignto = NULL,
  action = list(
    beginning = "t.test(",
    ending = ")"
    ),
  arguments = list(
    hypotheses = list(
      mu = list(
        type = "gedit",
        text = "0"
        ),
      alternative = alternative.list,
      paired = FALSE.list,
      var.equal = FALSE.list
      ),
    "CI" = list(
      conf.level = conf.level.list
      )
    )
  )

## ilcox test
wilcox.test.list = list(
  title = "wilcox.test()",
  help = "wilcox.test",
  type = "text",                        #either text or graphic
  variableType = "bivariate",
  assignto = NULL,
  action = list(
    beginning = "wilcox.test(",
    ending = ")"
    ),
  arguments = list(
    hypotheses = list(
      mu = list(
        type = "gedit",
        text = "0"
        ),
      alternative = alternative.list,
      paired = FALSE.list,
      var.equal = FALSE.list
      ),
    "CI" = list(
      conf.level = conf.level.list
      )
    )
  )


## var.test
var.test.list = list(
  title = "var.test()",
  help = "var.test",
  type = "text",                        #either text or graphic
  variableType = "bivariate",
  assignto = NULL,
  action = list(
    beginning = "var.test(",
    ending = ")"
    ),
  arguments = list(
    hypotheses = list(
      alternative= alternative.list,
      ratio = list(
        type = "gedit",
        text = 1
        )
      ),
    "CI" = list(
      conf.level = conf.level.list
      )
    )
  )



## bartlett
bartlett.test.list = list(
  title = "bartlett.test()",
  help = "bartlett.test",
  type = "text",                        #either text or graphic
  variableType = "model",
  assignto = NULL,
  action = list(
    beginning = "bartlett.test(",
    ending = ")"
    ),
  arguments = list(
    )
  )



## fligner
fligner.test.list = list(
  title = "fligner.test()",
  help = "fligner.test",
  type = "text",                        #either text or graphic
  variableType = "model",
  assignto = NULL,
  action = list(
    beginning = "fligner.test(",
    ending = ")"
    ),
  arguments = list(
    )
  )


## ansari.test
ansari.test.list = list(
  title = "ansari.test()",
  help = "ansari.test",
  type = "text",                        #either text or graphic
  variableType = "bivariate",
  assignto = NULL,
  action = list(
    beginning = "ansari.test(",
    ending = ")"
    ),
  arguments = list(
    hypotheses = list(
      alternative= alternative.list,
      exact = list(
        type = "gedit",
        text = ""
        )
      ),
    "CI" = list(
      conf.int = FALSE.list,
      conf.level = conf.level.list
      )
    )
  )

## cor.test
cor.test.list = list(
  title = "cor.test()",
  help = "cor.test",
  type = "text",                        #either text or graphic
  variableType = "bivariate",
  assignto = NULL,
  action = list(
    beginning = "cor.test(",
    ending = ")"
    ),
  arguments = list(
    hypotheses = list(
      alternative= alternative.list,
      method= list(
        type="gdroplist",
        items=c("\"pearson\"","\"kendall\"","\"spearman\"")
        ),
      exact = EMPTY.list
      ),
    "CI" = list(
      conf.level = conf.level.list
      )
    )
  )


## chisq.test
chisq.test.list = list(
  title = "chisq.test()",
  help = "chisq.test",
  type = "text",                        #either text or graphic
  variableType = "bivariate",
  assignto = NULL,
  action = list(
    beginning = "chisq.test(",
    ending = ")"
    ),
  arguments = list(
    "hypotheses" = list(
      correct = FALSE.list,
      p = list(
        type = "gedit",
        text = "0"
        )
      ),
    "calculate"=list(
      simulate.p.value = FALSE.list
      )
    )
  )

## mcnemar
mcnemar.test.list = list(
  title = "mcnemar.test()",
  help = "mcnemar.test",
  type = "text",                        #either text or graphic
  variableType = "bivariate",
  assignto = NULL,
  action = list(
    beginning = "mcnemar.test(",
    ending = ")"
    ),
  arguments = list(
    hypotheses = list(
      correct = TRUE.list
      )
    ),
  "CI" = list(
    conf.level = conf.level.list
    )
  )



## mantelhaen.tes
mantelhaen.test.list =  list(
  title = "mantelhaen.test()",
  help = "mantelhaen.test",
  type = "text",                        #either text or graphic
  variableType = "bivariate",
  assignto = NULL,
  action = list(
    beginning = "mantelhaen.test(",
    ending = ")"
    ),
  arguments = list(
    "hypotheses" = list(
      alternative= alternative.list,
      correct = TRUE.list,
      exact = FALSE.list
      ),
    "CI" = list(
      conf.level = conf.level.list
      )
    )
  )

## kolmogorov smirnov
ks.test.list = list(
  title = "ks.test()",
  help = "ks.test",
  type = "text",                        #either text or graphic
  variableType = "bivariate",
  assignto = NULL,
  action = list(
    beginning = "ks.test(",
    ending = ")"
    ),
  arguments = list(
    "Note:" = list(
      label = list(
        type="glabel",
        text = "Only does two sample ks.test"
        )
      ),
    "hypotheses" = list(
      alternative= alternative.list,
      exact = EMPTY.list
      ),
    "CI" = list(
      conf.level = conf.level.list
      )
    )


  )

## shapiro
shapiro.test.list = list(
  title = "shapiro.test()",
  help = "shapiro.test",
  type = "text",                        #either text or graphic
  variableType = "univariate",
  assignto = NULL,
  action = list(
    beginning = "shapiro.test(",
    ending = ")"
    )
  )

## oneway test
oneway.test.list = list(
  title = "oneway.test()",
  help = "oneway.test",
  type = "text",                        #either text or graphic
  variableType = "model",
  assignto = NULL,
  action = list(
    beginning = "oneway.test(",
    ending = ")"
    ),
  arguments = list(
    )
  )


### kruskal test
kruskal.test.list= list(
  title = "kruskal.test()",
  help = "kruskal.test",
  type = "text",                        #either text or graphic
  variableType = "model",
  assignto = NULL,
  action = list(
    beginning = "kruskal.test(",
    ending = ")"
    ),
  arguments = list(
    )
  )

  
##################################################
## add this for student convenience
summarized.t.test = function(xbar, sx, nx,
  ybar = NULL, sy=NULL, ny=NULL,
  alternative = c("two.sided", "less", "greater"),
  mu = 0, var.equal = FALSE,
  conf.level = 0.95) {
  
  paired = FALSE
  y = ybar
  
  alternative <- match.arg(alternative)
  
  if(!missing(mu) && (length(mu) != 1 || is.na(mu)))
    stop("'mu' must be a single number")
  if(!missing(conf.level) &&
     (length(conf.level) != 1 || !is.finite(conf.level) ||
      conf.level < 0 || conf.level > 1))
    stop("'conf.level' must be a single number between 0 and 1")

    dname = "Summarized data"
  
  ##  if( !is.null(y) ) {
    ## 	dname <- paste(deparse(substitute(x)),"and",
    ## 		       deparse(substitute(y)))
    ## 	if(paired)
    ## 	    xok <- yok <- complete.cases(x,y)
    ## 	else {
    ## 	    yok <- !is.na(y)
    ## 	    xok <- !is.na(x)
    ## 	}
    ## 	y <- y[yok]
    ##     }
    ##     else {
    ## 	dname <- deparse(substitute(x))
    ## 	if( paired ) stop("'y' is missing for paired test")
    ## 	xok <- !is.na(x)
    ## 	yok <- NULL
    ##     }
    ##     x <- x[xok]
    ##     if( paired ) {
    ## 	x <- x-y
## 	y <- NULL
##     }
###    nx <- length(x)
    if(nx < 2) stop("not enough 'x' observations")
    mx <- xbar ## mean(x)
    vx <- sx^2 ## var(x)
    estimate <- mx
    if(is.null(y)) {
	df <- nx-1
	stderr <- sqrt(vx/nx)
        if(stderr < 10 *.Machine$double.eps * abs(mx))
            stop("data are essentially constant")
	tstat <- (mx-mu)/stderr
	method <- ifelse(paired,"Paired t-test","One Sample t-test")
	names(estimate) <- ifelse(paired,"mean of the differences","mean of x")

      } else {
##	ny <- length(y)
	if(ny < 2) stop("not enough 'y' observations")
	my <- ybar ##mean(y)
	vy <- sy^2 ##var(y)
	method <- paste(if(!var.equal)"Welch", "Two Sample t-test")
	estimate <- c(mx,my)
	names(estimate) <- c("mean of x","mean of y")
	if(var.equal) {
	    df <- nx+ny-2
	    v <- ((nx-1)*vx + (ny-1)*vy)/df
	    stderr <- sqrt(v*(1/nx+1/ny))
	} else {
	    stderrx <- sqrt(vx/nx)
	    stderry <- sqrt(vy/ny)
	    stderr <- sqrt(stderrx^2 + stderry^2)
	    df <- stderr^4/(stderrx^4/(nx-1) + stderry^4/(ny-1))
	}
        if(stderr < 10 *.Machine$double.eps * max(abs(mx), abs(my)))
            stop("data are essentially constant")
        tstat <- (mx - my - mu)/stderr
    }
    if (alternative == "less") {
	pval <- pt(tstat, df)
	cint <- c(-Inf, tstat + qt(conf.level, df) )
    }
    else if (alternative == "greater") {
	pval <- pt(tstat, df, lower = FALSE)
	cint <- c(tstat - qt(conf.level, df), Inf)
    }
    else {
	pval <- 2 * pt(-abs(tstat), df)
	alpha <- 1 - conf.level
        cint <- qt(1 - alpha/2, df)
	cint <- tstat + c(-cint, cint)
    }
    cint <- mu + cint * stderr
    names(tstat) <- "t"
    names(df) <- "df"
    names(mu) <- if(paired || !is.null(y)) "difference in means" else "mean"
    attr(cint,"conf.level") <- conf.level
    rval <- list(statistic = tstat, parameter = df, p.value = pval,
	       conf.int=cint, estimate=estimate, null.value = mu,
	       alternative=alternative,
	       method=method, data.name=dname)
    class(rval) <- "htest"
    return(rval)
  }

## make a generic widget for this

## t.test
t.test.summaries.list = list(
  title = "t.test() (summarized)",
  help = "t.test",
  type = "text",                      # either text or graphic
  variableType = NULL,
  assignto = NULL,
  action = list(
    beginning = "summarized.t.test(",
    ending = ")"
    ),
  arguments = list(
    data = list(
      xbar=list(type="gedit",text=""),
      ybar=list(type="gedit",text=""),
      sx=list(type="gedit",text=""),
      sy=list(type="gedit",text=""),
      nx=list(type="gedit",text=""),
      ny=list(type="gedit",text="")
      ),
    hypotheses = list(
      mu = list(
        type = "gedit",
        text = "0"
        ),
      alternative = alternative.list,
#      paired = FALSE.list,
      var.equal = FALSE.list
      ),
    "CI" = list(
      conf.level = conf.level.list
      )
    )
  )

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.datamanipulation.R"
## Dialogs for data manipulation


## dialog for finding subsets
## return a group object
pmg.subset.dialog = function(container=NULL) {

  group  = ggroup(horizontal=FALSE, container=container)

  frame = gframe("<b>Data</b>",markup=TRUE, container=group)

  table = glayout()
  table[1,1] = glabel("x=")
  dataEntry = gedit("",width=30)
  table[1,2] = dataEntry
  ## subset
  table[2,1] = glabel("subset=")
  subsetEntry = gedit("",width=30)
  table[2,2] = subsetEntry
  subsetButton = gbutton("edit",handler = function(h,...) {
    editSubsetDialog(data=svalue(dataEntry),
                     widget=subsetEntry)})
  table[2,3] = subsetButton
  ## select
  table[3,1] = glabel("select=")
  selectEntry = gedit("", width=30)
  table[3,2] = selectEntry
  selectButton = gbutton("edit",handler = function(h,..) {
    editSelectDialog(data=svalue(dataEntry),
                     widget=selectEntry
                     )})
  table[3,3] = selectButton

  table[4,1] = glabel("drop=")
  dropEntry = gradio(c("TRUE","FALSE"),index=FALSE,selected=2)
  table[4,2] = dropEntry

  table[5,1] = glabel("assign to:")
  assignEntry = gedit("",width=30)
  table[5,2] = assignEntry
  
  submitButton = gbutton("submit",handler=function(h,...) {
    dataValue = svalue(dataEntry)
    subsetValue = svalue(subsetEntry)
    selectValue = svalue(selectEntry)
    dropValue = svalue(dropEntry)
    assignValue = svalue(assignEntry)
    if(assignValue == "")
      assignValue = NULL
    ## use pmg.cli to evaluate
    if(dataValue == "") {
      warning("No dataset chosen")
      return(NULL)
    }
    string = Paste("subset(", dataValue)
    if(nchar(subsetValue)>0) 
      string = Paste(string,", subset=",subsetValue)
    if(nchar(selectValue)>0)
      string = Paste(string, ", select=",selectValue)
    string = Paste(string,",drop=",dropValue,")")

    names(string) = assignValue
    svalue(pmg.cli) <- string

    ## close dialog?
    ##     if(!is.null(win))
    ##       dispose(win)
  })
  
  table[6,3] = submitButton

  add(frame, table,expand=TRUE)
  visible(table) <-  TRUE

  return(group)
}
  


##################################################

## edit data frame properties

pmg.edit.dataframe.properties.dialog = function(container=NULL) {

  ## in gWIdgetsRGtkw, but not exported?
  lsType = function(type, envir=.GlobalEnv) {
    x = with(.GlobalEnv, sapply(ls(), function(i) class(get(i))))
    objects = names(x)[sapply(x, function(i) any(i %in% type))]
  return(objects)
  }
  
  

  ## need means to select the data frame, popup this for editing

  g = ggroup(horizontal=FALSE, cont=container)

  add(g, glabel("This dialog allows you to change the\n name, and data type for the columns of a data frame."))
  add(g, gseparator())
  
  tbl = glayout(cont=g)

  allDFs = lsType("data.frame")
  selHandler = function(h,...) {
    newDFName = svalue(selectDF)
    .editDFProperties(newDFName)
  }
  selectDF = gdroplist(c("",allDFs), editable=TRUE, handler = selHandler)

  tbl[1,1] = glabel("Select a data frame:")
  tbl[2,1] = selectDF
  tbl[2,2] = gbutton("edit",handler=selHandler)
  
  visible(tbl) <- TRUE
  
  return(g)
  
}



.editDFProperties = function(dfname,envir=.GlobalEnv) {
  dlg = BasicGUI$new(sprintf("Edit properties for %s.",dfname))

  ## some defs
  dlg$allTypes = c("","numeric","integer","character","factor","logical")
  dlg$getType = function(.,i) head(class(i),n=1)



  ## validate name
  df = try(get(dfname,envir=envir), silent=TRUE)
  if(inherits(df,"try-error")) {
    cat("Need to have a data frame name.\n")
    return()
  }


  ## Store the data. We make changes to df as we update
  dlg$dfname <- dfname
  dlg$df <- df                          # make a copy
  
  dlg$colTypes = function(.) sapply(.$df,getType)

  
  ## Display dialog
  dlg$makeBody = function(., container) {
    g <- ggroup(horizontal=FALSE, cont=container, expand=TRUE)
    glabel(gettext("Edit names and column types"),cont=g)
    tbl <- glayout(cont=g, expand=TRUE)

    tbl[1,1] <- "Which column:"         # no ?, : ala apple
    tbl[1,2] <- (.$columnDroplistGroup <- ggroup(cont=tbl))
    .$columnDroplist <- gdroplist(names(.$df), cont=.$columnDroplistGroup)
    
    tbl[2,1] <- "Column type:"
    tbl[2,2] <- (.$columnTypeDroplist <- gdroplist(.$allTypes, cont=tbl))
    svalue(.$columnTypeDroplist) <- .$getType(.$df[,1]) ## initialize

    tbl[3,1] <- "Column name:"
    tbl[3,2] <- (.$columnNameDroplist <- gedit(names(.$df)[1], cont=tbl))

    visible(tbl) <- TRUE

    gseparator(cont=g)

    ## Show the current data frame
    .$dfGroup = ggroup(cont=g, expand=TRUE)
    .$dfShow = gdf(head(.$df), cont=.$dfGroup,expand=TRUE)
#    enabled(.$dfShow) <- FALSE
    
    bg <- ggroup(cont=g)
    glabel("Save data frame as", cont=bg)
    .$saveName <- gedit(.$dfname, cont=bg)

    ## helper
    getIndex = function(.) {
      svalue(.$columnDroplist, index=TRUE)
    }      


    
    ## Now add handlers
    ## change colType
    addHandlerChanged(.$columnTypeDroplist,action=.,
                      handler = function(h,...) {
      ## get current var by index
      . = h$action
      ind = getIndex(.)
      coerceTo = svalue(h$obj)
      ## commit change
      .$df[,ind] <- do.call(paste("as.",coerceTo,sep="",collapse=""),
                            list(.$df[,ind]))
      updateDF(.)
    })

    addHandlerChanged(.$columnNameDroplist, action=.,
                      handler = function(h,...) {
                        ## handler for updating names
                        . = h$action
                        ## get variable index
                        ind = getIndex(.)

                        newName = make.names(svalue(h$obj))
                        ## validate
                        if(newName %in% names(.$df)) {
                          ## uniqueness not essential for a data frame
                          ## but is included here. Could leave out
                          cat(gettext("Specify a new, unique column name\n"))
                          return(FALSE)
                        }
                        ## aok
                        names(.$df)[ind] <- newName
                        ## update things
                        updateDF(.)
                        updateNames(.,ind)
                      })
    ## replace data frame in disply
    updateDF = function(.) {
      delete(.$dfGroup, .$dfShow)
      .$dfShow = gdf(head(.$df), cont=.$dfGroup, expand=TRUE)
#      enabled(.$dfShow) <- FALSE
    }

    ## name droplist is trickier
    updateNames = function(.,ind) {
      ## now update names droplist, add in handler
      delete(.$columnDroplistGroup,.$columnDroplist)
      .$columnDroplist <- gdroplist(names(.$df),container=.$columnDroplistGroup)
      svalue(.$columnDroplist,index=TRUE) <- ind
      addHandlerChanged(.$columnDroplist, action=.,
                        handler = function(h,...) {
                          . = h$action
                          ind = svalue(h$obj, index=TRUE)
                          svalue(.$columnTypeDroplist) <- .$getType(.$df[,ind])
                          svalue(.$columnNameDroplist) <- names(.$df)[ind]
                        })
    }
    ## initialize -- to add handler, isn't added above
    updateNames(.,1)
  }
  
  dlg$clearButtonHandler = NULL
  dlg$okButtonHandler = function(.,h,...) {
    ## verify that name is okay
    outputName = svalue(.$saveName)
    if(outputName %in% ls(envir=.GlobalEnv)) {
      out = gconfirm(sprintf("There is already a varibable named %s. Overwrite?", outputName))
      if(!out) {
        return(FALSE)
      }
    }
    ## write
    assign(outputName, df, envir=.GlobalEnv)
    ## close up
    dispose(.$window)
  }


  ## now sohw the dialog
  dlg$show()
}

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.datamenu.R"

## gtkDataViewer
dataViewer.list = list(
  title = "browseDataAsCSV()",
  help = "browseDataAsCSV",
  action = list(
    beginning = "browseDataAsCSV(",
    ending = ")"
    ),
  variableType = NULL,
  type = "text",                      # either text or graphic
  arguments = list(
    arguments = list(
      dataset = list(
        type = "gedit",
        text = ""
        )
      )
    )
  )


write.csv.list = list(
  title = "write.csv()",
  help = "write.csv",
  type = "text",                      # either text or graphic
  assignto = NULL,
  variableType = NULL,           # uni/bi/model/lattice
  action = list(
    beginning = "write.csv(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      x = list(
        type = "gedit"
        ),
      file = list(
        type = "gfilebrowse",
        quote=TRUE
        ),
      row.names = list(
        type = "gdroplist",
        items = c(FALSE,TRUE)
        ),
      col.names = list(
        type = "gdroplist",
        items = c(TRUE, FALSE)
        ),
      append = list(
        type = "gdroplist",
        items = c(FALSE, TRUE)
        ),
      quote =  list(
        type = "gdroplist",
        items = c(TRUE, FALSE)
        )
      )
    )
  )


## table and xtabs
table.list = list(
  title = "table()",
  help = "table",
  action = list(
    beginning = "table(",
    ending = ")"
    ),
  variableType = "bivariate",
  type = "text",                      # either text or graphic
  assignto = TRUE,
  arguments = list(
    arguments = list(
      exclude = list(
        type="gdroplist",
        items = "c(NA,NaN)"
        ),
      deparse.level = list(
        type = "gedit",
        text = 1
        )
      )
    )
  )

xtabs.list = list(
  title = "xtabs()",
  help = "xtabs",
  action = list(
    beginning = "xtabs(",
    ending = ")"
    ),
  variableType = "model",
  type = "text",                      # either text or graphic
  assignto = TRUE,
  arguments = list(
    arguments = list(
      drop.unused.levels = FALSE.list
      )
    )
  )

## EDA functions
stem.list = list(
  title = "stem()",
  help = "stem",
  type="text",
  assignto = NULL,
  variableType = "univariate",
  action = list(
    beginning = "stem(",
    ending=")"
    ),
  arguments = list(
    arguments=list(
      scale = list(
        type="gedit",
        text=1
        ),
      width = list(
        type="gspinbutton",
        from = 30,
        to=100,
        value = 80,
        by=1,
        digits = 0,
        horizontal=TRUE
        )
      )
    )
  )

## summary
summary.list = list(
  title = "summary()",
  help = "summary",
  type="text",
  assignto = NULL,
  variableType = NULL,
  action = list(
    beginning = "summary(",
    ending=")"
    ),
  arguments = list(
    data = list(
      object = list(
        type="gedit",
        text = ""
        )
      )
    )
  )

## mean
mean.list = list(
  title = "mean()",
  help = "mean",
  type = "text",                      # either text or graphic
  assignto = NULL,
  variableType = "univariate",           # uni/bi/model/lattice
  action = list(
    beginning = "mean(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      trim = list(
        type = "gspinbutton",
        from = 0,
        to = 0.5,
        by = 0.05,
        digits = 2
        ),
      na.rm = TRUE.list
      )
    )
  )

## median
median.list = list(
  title = "median()",
  help = "median",
  type = "text",                      # either text or graphic
  assignto = NULL,
  variableType = "univariate",           # uni/bi/model/lattice
  action = list(
    beginning = "median(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      na.rm = TRUE.list
      )
    )
  )

## sd
sd.list = list(
  title = "sd()",
  help = "sd",
  type = "text",                      # either text or graphic
  assignto = NULL,
  variableType = "univariate",           # uni/bi/model/lattice  
  action = list(
    beginning = "sd(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      na.rm = TRUE.list
      )
    )
  )

## IQR
IQR.list = list(
  title = "IQR()",
  help = "IQR",
  type = "text",                      # either text or graphic
  assignto = NULL,
  variableType = "univariate",           # uni/bi/model/lattice
  action = list(
    beginning = "IQR(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
    na.rm = TRUE.list
      )
    )
  )

## mad
mad.list = list(
  title = "mad()",
  help = "mad",
  type = "text",                      # either text or graphic
  assignto = NULL,
  variableType = "univariate",           # uni/bi/model/lattice
  action = list(
    beginning = "mad(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      constant = list(
        type = "gedit",
        text = 1.4826
        ),
      na.rm = TRUE.list,
      low = FALSE.list,
      high = FALSE.list
      )
    )
  )

## skewness
skewnessList = list(
  title = "skewness()",
  help = "",
  type = "text",                      # either text or graphic
  assignto = TRUE,
  variableType = "univariate",           # uni/bi/model/lattice
  action = list(
    beginning = "skewness(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      na.rm = TRUE.list
      )
    )
  )

## kurtosis
kurtosisList = list(
  title = "kurtosis()",
  help = "",
  type = "text",                      # either text or graphic
  assignto = TRUE,
  variableType = "univariate",           # uni/bi/model/lattice
  action = list(
    beginning = "kurtosis(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      na.rm = TRUE.list
      )
    )
  )

## dpqr functions
## normal
pdf.normal.list = list(
  title = "dnorm()",
  help = "dnorm",
  type = "text",                      # either text or graphic
  assignto = NULL,
  action = list(
    beginning = "dnorm(",
    ending = ")"
    ),
  arguments = list(
    arugments = list(
      x = list(
        type = "gedit",
        text = ""
        )
      ),
    parameters=list(
      mean = list(
        type = "gedit",
        text = "0"
        ),
      sd = list(
        type = "gedit",
        text = "1"
        )
      ),
    others = list(
      log= FALSE.list
      )
    )
  )
  

quantile.normal.list = list(
  title = "qnorm()",
  help = "qnorm",
  type = "text",                      # either text or graphic
  assignto = NULL,
  action = list(
    beginning = "qnorm(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      p = list(
        type = "gedit",
        text = ""
        )
      ),
    parameters = list(
      mean = list(
        type = "gedit",
        text = "0"
      ),
      sd = list(
        type = "gedit",
        text = "1"
        )
      ),
    others = list(
      lower.tail= TRUE.list,
      log.p= FALSE.list
      )
    )
  )
  

random.normal.list = list(
  title = "rnorm()",
  help = "rnorm",
  type = "text",                      # either text or graphic
  assignto = TRUE,
  action = list(
    beginning = "rnorm(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
    n = list(
      type = "gedit",
      text = ""
      )
      ),
    parameters=list(
    mean = list(
      type = "gedit",
      text = "0"
      ),
    sd = list(
        type = "gedit",
        text = "1"
        )
    )
  )
  )

## t-dist
pdf.t.list = list(
  title = "dt()",
  help = "dt",
  type = "text",                      # either text or graphic
  assignto = NULL,
  action = list(
    beginning = "dt(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      x = EMPTY.list
      ),
    parameters = list(
      df = list(
        type = "gedit",
        text = "0"
        ),
      ncp = list(
        type = "gedit",
        text = "0"
        )
      )
    ),
  others = list(
    log= FALSE.list
    )
  )


quantile.t.list = list(
  title = "qt()",
  help = "qt",
  type = "text",                      # either text or graphic
  assignto = NULL,
  action = list(
    beginning = "qt(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      p = EMPTY.list
      ),
    parameters = list(
      df = EMPTY.list
      ),
    others = list(
      lower.tail= TRUE.list,
      log.p= FALSE.list
      )
    )
  )

random.t.list = list(
  title = "rt()",
  help = "rt",
  type = "text",                      # either text or graphic
  assignto = TRUE,
  action = list(
    beginning = "rt(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      n = EMPTY.list
      ),
    parameters=list(
      df = list(
        type = "gedit",
        text = "0"
        )
      )
    )
  )


## exponential
pdf.exp.list = list(
  title = "dexp()",
  help = "dexp",
  type = "text",                      # either text or graphic
  assignto = NULL,
  action = list(
    beginning = "dexp(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      x = EMPTY.list
      ),
    parameters=list(
      rate = list(
        type = "gedit",
        text = "1"
        )
      ),
    others = list(
      log= FALSE.list
      )
    )
  )


quantile.exp.list = list(
  title = "qexp()",
  help = "qexp",
  type = "text",                      # either text or graphic
  assignto = NULL,
  action = list(
    beginning = "qexp(",
    ending = ")"
    ),
  arguments = list(
    arguments = list(
      p = EMPTY.list
      ),
    parameters=list(
      rate = list(
        type = "gedit",
        text = "1"
        )
      ),
    others = list(
      lower.tail= TRUE.list,
      log.p= FALSE.list
      )
    )
  )
random.exp.list = list(
  title = "rexp()",
  help = "rexp",
  type = "text",                      # either text or graphic
  assignto = TRUE,
  action = list(
    beginning = "rexp(",
    ending = ")"
    ),
  arguments = list(
    arguments=list(
      n = EMPTY.list
      ),
    parameters=list(
      rate = list(
        type = "gedit",
        text = "1"
        )
      )
    )
  )


## uniform
pdf.uniform.list = list(
  title = "dunif()",
  help = "dunif",
  type = "text",                      # either text or graphic
  assignto = NULL,
  action = list(
    beginning = "dunif(",
    ending = ")"
    ),
  arguments = list(
    arguments=list(
    x = EMPTY.list
      ),
    parameters=list(
      min = list(
        type = "gedit",
        text = "0"
        ),
    max = list(
      type = "gedit",
      text = "1"
      )
      ),
    others = list(
      log= FALSE.list
      )
    )
  )

quantile.uniform.list = list(
  title = "qunif()",
  help = "qunif",
  type = "text",                      # either text or graphic
  assignto = NULL,
  action = list(
    beginning = "qunif(",
    ending = ")"
    ),
  arguments = list(
    arguments=list(
    p = EMPTY.list
      ),
    parameters=list(
      min = list(
        type = "gedit",
        text = "0"
      ),
      max = list(
        type = "gedit",
        text = "1"
      )
      ),
    others = list(
      lower.tail= TRUE.list,
      log.p= FALSE.list
      )
    )
  )

random.uniform.list = list(
  title = "runif()",
  help = "runif",
  type = "text",                      # either text or graphic
  assignto = TRUE,
  action = list(
    beginning = "runif(",
    ending = ")"
    ),
  arguments = list(
    arguments=list(
      n = EMPTY.list
      ),
    parameters=list(
      min = list(
        type = "gedit",
        text = "0"
        ),
      max = list(
        type = "gedit",
        text = "1"
        )
      )
    )
  )


#######
sample.list = list(
  title = "sample()",
  help = "sample",
  action = list(
    beginning = "sample(",
    ending = ")"
    ),
  variableType = "univariate",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      size = EMPTY.list,
      replace = FALSE.list,
      prob = EMPTY.list
      )
    )
  )



##################################################
## stack, unstack, subset
 ##?? Do  theses fit in?


stack.list = list(
  title = "stack()",
  help = "stack",
  action = list(
    beginning = "stack(",
    ending = ")"
    ),
  variableType = NULL,           # uni/bi/model/lattice/NULL
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    Variables = list(                   # types in genericWidget
      x = list(
        type = "geditnamedlist",
        val = ""
        ),
      y= list(
        type = "glabel",
        text = "Drag value(s) to stack into x area"
        )
      )
    )
  )

unstack.list = list(
  title = "unstack()",
  help = "unstack",
  action = list(
    beginning = "unstack(",
    ending = ")"
    ),
  variableType = NULL,           # uni/bi/model/lattice/NULL
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    Variables = list(                   # types in genericWidget
      x = EMPTY.list
      )
    )
  )


## subset -- use pmg.subset.dialog instead
subset.list =  list(
  title = "subset()",
  help = "subset",
  action = list(
    beginning = "subset(",
    ending = ")"
    ),
  variableType = "univariate",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      subset= EMPTY.list,
      select = EMPTY.list,
      drop = FALSE.list
      )
    )
  )


## bivariate
cor.list = list(
  title = "cor()",
  help = "cor",
  action = list(
    beginning = "cor(",
    ending = ")"
    ),
  variableType = "bivariate",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      method = list(
        type="gdroplist",
        items = c('"pearson"', '"kendall"', '"spearman"')
        ),
      use =  list(
        type="gdroplist",
        items = c('"all.obs"', '"complete.obs"', '"pairwise.complete.obs"')
        )
      )
    )
 )

blank.list = list(
  title = "blank",
  help = "blank",
  action = list(
    beginning = "writeme(",
    ending = ")"
    ),
  variableType = "bivariate",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      writeme = list(
        type="gedit",
        text = "Write me"
        )
      )
    )
 )

## coerce stuff
as.numeric.list =  list(
  title = "as.numeric()",
  help = "as.numeric",
  action = list(
    beginning = "as.numeric(",
    ending = ")"
    ),
  variableType = "univariate",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE                      # TRUE for assignto
  )


as.character.list = list(
  title = "as.character()",
  help = "as.character",
  action = list(
    beginning = "as.character(",
    ending = ")"
    ),
  variableType = "univariate",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE                      # TRUE for assignto
  )

data.frame.list = list(
  title = "data.frame()",
  help = "data.frame",
  action = list(
    beginning = "data.frame(",
    ending = ")"
    ),
  variableType = NULL,           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  suppressDotDotDot = TRUE,             # TRUE to suppress, NULL to handle
  arguments = list(
    variables = list(
      "..." = list(
        type="geditnamedlist",
        val = "",
        wideBody = TRUE                      # big and fat boy
        )
      ),
    "arguments"=list(
      row.names = list(
        type="gedit",
        text=""
        ),
      blank = list(
        type="glabel",
        text=""
        ),
      check.rows = TRUE.list,
      check.names = TRUE.list
      )
    )
  )

as.data.frame.list =list(
  title = "as.data.frame()",
  help = "as.data.frame",
  action = list(
    beginning = "as.data.frame(",
    ending = ")"
    ),
  variableType = "univariate",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    argument=list(
      row.names = list(
        type="gdroplist",
        items = c("","NULL")
        ),
      optional = FALSE.list
      )
    )
  )

matrix.list = list(
  title = "matrix()",
  help = "matrix",
  action = list(
    beginning = "matrix(",
    ending = ")"
    ),
  variableType = NULL,           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    argument=list(
      data = list(
        type="gedit",
        text = "NA"
        ),
      blank = list(
        type="glabel",
        text=""
        ),
      nrow = list(
        type="gedit",
        text=1
        ),
      ncol = list(
        type="gedit",
        text=1
        ),
      byrow = FALSE.list,
      dimnames = list(
        type="gedit",
        text = "NULL"
        )
      )
    )
  )

as.matrix.list =  list(
  title = "as.matrix()",
  help = "as.matrix",
  action = list(
    beginning = "as.matrix(",
    ending = ")"
    ),
  variableType = "univariate",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE                      # TRUE for assignto
  )

groupedData.list = list(
  title = "groupedData()",
  help = "groupedData",
  action = list(
    beginning = "groupedData(",
    ending = ")"
    ),
  variableType = "lattice",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    argument=list(
      outer = list(
        type="gedit",
        text=""
        ),
      inner = list(
        type="gedit",
        text = ""
        ),
      labels = list(
        type="gedit",
        text = ""
        ),
      units = list(
        type="gedit",
        text = ""
        )
      ),
    ordered = list(
            order.groups = FALSE.list,
      FUN = list(
        type="gedit",
        text=""
        )
      )
    )
  )

factor.list = list(
  title = "factor()",
  help = "factor",
  action = list(
    beginning = "factor(",
    ending = ")"
    ),
  variableType = NULL,           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    variables=list(
      x = EMPTY.list
      ),
    argument=list(
      levels = list(
        type="gdroplist",
        items = c("","sort(unique.default(x)")
        ),
      labels = list(
        type="gdroplist",
        items=c("","levels")
        ),
      exclude = list(
        type="gdroplist",
        items=c("","NA")
        ),
      ordered = list(
        type="gdroplist",
        items=c("","is.ordered(x)")
        )
      )
    )
  )
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.filemenu.R"

exit.pmg = function(w) {
  ## use pmg.window global by name
  pmg.window$Hide()
  pmg.window$Destroy()
  assignInNamespace("pmg.window",NULL, "pmg")
}


## genericWidget lists
read.table.list = list(
  title = "read.table()",
  help = "read.table",
  action = list(
    beginning = "read.table(",
    ending = ")"
    ),
  type = "text",                        #either text or graphic
  variableType = "fileurl",
  assignto = TRUE,
  arguments = list(
    arguments = list(
      header=FALSE.list,
      sep = list(
        type = "gedit",
        text = "\"\""
        ),
#      quote = list(
#        type = "gedit",
#        text = "\"'"
#        ),
      dec = list(
        type = "gedit",
        text = "\".\""
        ),
      skip = list(
        type = "gedit",
        text = 0
        ),
      check.names = TRUE.list,
      comment.char = list(
        type = "gedit",
        text = "\"#\""
        )
      )
    )
  )


## fwf
read.fwf.list = list(
  title = "read.fwf()",
  help = "read.fwf",
  action = list(
    beginning = "read.fwf(",
    ending = ")"
    ),
  type = "text",                        #either text or graphic
  variableType = "fileurl",
  assignto = TRUE,
  arguments = list(
    arguments = list(
      widths = list(
        type="gedit",
        text = ""
        ),
      header=FALSE.list,
      sep = list(
        type = "gedit",
        text = "\"\""
        ),
      as.is = FALSE.list,
      skip = list(
        type = "gedit",
        text = 0
        )
      )
    )
  )


## csv
read.csv.list = list(
  title = "read.csv()",
  help = "read.csv",
  action = list(
    beginning = "read.csv(",
    ending = ")"
    ),
  type = "text",                        #either text or graphic
  variableType = "fileurl",
  assignto = TRUE,
  arguments = list(
    arguments = list(
      header=FALSE.list,
      sep = list(
        type = "gedit",
        text = "\"\""
        ),
#      quote = list(
#        type = "gedit",
#        text = "\"'"
#        ),
      dec = list(
        type = "gedit",
        text = "\".\""
        )
      )
    )
  )

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.installCRANPackage.R"
## install cran

## helper functions
pmg.chooseCRANmirror = function(widget = NULL, doing.first=FALSE,...) {
  ## copied from tcltk widget

  ## if doing.first == TRUE, then call pmg.installCRANPackage after click
  ## This is from packages.R in chooseCRANmirror
  m <- try(read.csv(url("http://cran.r-project.org/CRAN_mirrors.csv"),
                    as.is=TRUE))
  if(inherits(m, "try-error"))
    m <- read.csv(file.path(R.home("doc"), "CRAN_mirrors.csv"), as.is=TRUE)  
    
  window=pmgWC$new(title="Select CRAN site", visible=FALSE)
  size(window) <- c(500,400)
  group = ggroup(horizontal=FALSE, container = window)

  tbl = gtable(utils:::getCRANmirrors(), chosencol=4, 
    filter.column=2,
    handler = function(h,...) {
      URL = svalue(tbl)
      repos <- getOption("repos")
      repos["CRAN"] <- gsub("/$", "", URL[1])
      options(repos = repos)
      dispose(window)
      ## now install
      if(doing.first) pmg.installCRANPackage()
    })
  add(group, tbl, expand=TRUE)
  status = gstatusbar("Double click site to select", container=group)
  visible(window) <- TRUE               # now show the window
}

## return a data frame with the CRAN packages
.empty.CRANPackages.data.frame = function() {
  tmp = data.frame(Package="", CRAN.version="", Installed.version="",Depends="",Suggests="")
  for(j in 1:5) tmp[,j] = as.character(tmp[,j])
  return(tmp)
}
pmg.getCRANPackages = function() {
  
    ## what is installed?
    x <- installed.packages()
    i.pkgs <- as.character(x[, 1])
    i.vers <- as.character(x[, 3])
    
    
#    y = CRAN.packages()
    y = available.packages()
    if(nrow(y) == 0) {                    # if empty
      return(.empty.CRANPackages.data.frame())
    }

    
    c.pkgs <- as.character(y[, 1])
    c.vers <- as.character(y[, 2])
    c.depends <- as.character(y[,5])
    c.suggest <- as.character(y[,7])
    idx <- match(i.pkgs, c.pkgs)
    vers2 <- character(length(c.pkgs))
    
    xx <- idx[which(!is.na(idx))]
    vers2[xx] <- i.vers[which(!is.na(idx))]
    i.vers <- vers2
    
    cranPkgs = data.frame(
      Package=c.pkgs,
      CRAN.version=c.vers,
      Installed.version=i.vers,
      Depends = c.depends,
      Suggets = c.suggest
      )
    ## make character -- not factor, gtable barks otherwise
    for(j in 1:5) cranPkgs[,j] = as.character(cranPkgs[,j])
    ## filter out NA values
    cranPkgs = cranPkgs[!is.na(cranPkgs[,1]),]

    return(cranPkgs)
}

needToChooseCRANMirror = function() {
  if(is.null(getOption("repos")) ||
     is.na(getOption("repos")) ||
     getOption("repos") == "@CRAN@" ||
     getOption("repos") == ""
     )
    return(TRUE)
  else
    return(FALSE)
}


pmg.installCRANPackage = function() {

  if(needToChooseCRANMirror()) {
    return(pmg.chooseCRANmirror(doing.first=TRUE))
  }

  
  ## add list of packages to packageList
  addPackageList = function() {
    ## update repos from box
    ## we add to packageList provided various things are satisfied
    if(needToChooseCRANMirror()) {
      svalue(statusBar) <- "Set the CRAN repository before continuing"
      return()
    }
    if(is.null(svalue(libBox))) {
      svalue(statusBar)  <- "Set the 'Install to' directory before continuing."
      return()
    }

    svalue(statusBar)  <- "Loading available CRAN packages from internet"
    ## okay lets load it up

    m = pmg.getCRANPackages()
    packageList[,] = m
##    delete(packageGroup, packageList)
##    packageList <<- gtable(m , filter.labels = c("",letters),
##                               filter.FUN=filter.FUN)
##
##    add(packageGroup, packageList, expand=TRUE)
    enabled(installButton) <- TRUE                 # was grayed out
    svalue(statusBar) <-  ""
  }
  

  
  ## start with the GUI
  win = pmgWC$new("Install CRAN packages",v=T)

  mainGroup = ggroup(horizontal=FALSE, container=win)
  table = glayout(container=mainGroup)
  table[1,1] = glabel("CRAN repository:")
  reposBox = gedit(getOption("repos")[1],
    handler = function(h,...) {
      repository = as.character(svalue(h$obj))
      if(!is.empty(repository)) {
        options("repos",repository)
        addPackageList()
      }
  })
##   ## this is really changed
##   addhandlerkeystroke(reposBox,handler = function(h,...) {
##     repository = as.character(svalue(h$obj))
##     if(nchar(repository) > 0)
##       options("repos",repository)
##     addPackageList()
##   })
  table[1,2] = reposBox
  reposButton = gbutton("preferences",dirname="stock")
  addhandlerclicked(reposButton,
                    handler = function(h,...) {
                      pmg.chooseCRANmirror(widget=reposBox)
                      svalue(statusBar) <- ""
                      ## can't update here as repoxBox isn't set by now
                    })
  table[1,3] = reposButton
  
  table[2,1] = glabel("Install to:")
  libBox = gdroplist(.libPaths(), editable=TRUE,
    handler = function(h,...) {
      svalue(statusBar) <- ""
      addPackageList()
    }
    )
  table[2,2] = libBox
  libButton = gbutton("preferences",dirname="stock")
  addhandlerclicked(libButton, handler = function(h,...) {
    gfile("Pick a directory...", type = "selectdir", handler = function(h,...) {
      svalue(libBox) <- svalue(h$obj)
      addPackageList()
    })
  })
  table[2,3] = libButton

  table[3,1] = glabel("Install dependencies?")
  dependenciesBox = gdroplist(c("TRUE","FALSE"))
  table[3,2] = dependenciesBox
  
  table[4,1] = glabel("Package type:")
  typeBox = gdroplist(c("source","mac.binary","win.binary"))
  table[4,2] = typeBox
  
  statusBar = gstatusbar("")
  installButton = gbutton("Install selected package(s)",
    handler=function(h,...) {
      thePackages = svalue(packageList)
      svalue(statusBar) <- Paste("installing package: ",thePackages)
      install.packages(
                       pkgs = thePackages,
                       lib = svalue(libBox),
                       type = svalue(typeBox)
                       )
      svalue(statusBar) <- "Packages were installed. (Versions not updated)"
                                        #          dispose(win)
    })
  enabled(installButton) <- FALSE
  closeButton = gbutton("cancel",handler = function(h,...) {
    dispose(win)
  })
  

  packageGroup = ggroup()
  add(mainGroup, packageGroup, expand=TRUE)

  firstLetter = function(x) tolower(unlist(strsplit(x,""))[1])
  filter.FUN = function(d, val ) {
    if(val == "") 
      return(rep(TRUE, dim(d)[1]))
    else
      sapply(d[,1],firstLetter) == val
  }

  ## start with an empty data frame
  m = .empty.CRANPackages.data.frame()
  packageList <- gtable(m , filter.labels = c("",letters),
                             filter.FUN=filter.FUN)
  size(packageList) <- c(400,300)
  
  add(packageGroup, packageList, expand=TRUE)
  visible(table) <-TRUE
  gseparator(container=mainGroup)
  buttonGroup = ggroup(container=mainGroup)
  addSpring(buttonGroup)
  add(buttonGroup,installButton)
  add(buttonGroup,closeButton)
  
  add(mainGroup, statusBar)
  
  ## now add, hopefull the thing has been drawn alread
  addPackageList()


}
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.iplots.R"
## pmg interface to iplots
## main functino pmg.iplots

## deal with a data frame
.newSet = function(df, name,container=NULL,...) {

  ## globals ###########################
  plotList = list()                     # list of made plots, for getting names

  setISetByName = function(name) {
    if(name %in% names(iset.list())){
      iset.set(which(name == names(iset.list())))
    }
  }

  ## set up a new iset if not there
  if(name %in% names(iset.list())){
    iset.set(which(name == names(iset.list())))
  } else {
    iset.new(name=name)
    iset.df(df)
  }
  
  ################################################
  ## objects
  dfnames = names(df)
  namesDF = data.frame(name=dfnames,type=sapply(df,class),
    stringsAsFactors = FALSE)

  varNames = gtable(namesDF, multiple=TRUE)
  adddropsource(varNames)
    
  ## plot selector
  availPlots = c("select plot","ibar","ihist","ibox","imosaic","ipcp","ihammock","iplot")
  newPlotSelector = gdroplist(availPlots)

  ## showMadePlots
  showCurPlotIcon = gimage("symbol_none",dirname="stock")
  showCurPlotName = glabel("click to update")
  nextPlot = gimage("rarrow",dir="stock")
  curPlot  = gimage("uarrow",dir="stock")
  prevPlot = gimage("larrow",dir="stock")

  
  ## add objects
  availObjects = c("","ilines","iabline","itext","remove last added")
  addObjectsSelector = gdroplist(availObjects)

  ## list objects
  showCurObject = glabel("")
  nextObject = gimage("rarrow",dir="stock")
  curObject  = gimage("uarrow",dir="stock")
  prevObject = gimage("larrow",dir="stock")
  
  ## selections
  getSelectedButton = gbutton("get selected")
  setSelectedButton = gbutton("set selected")
  showSelected = gtext("")


  ## layout #########################
  lgroup = ggroup(horizontal=FALSE)
  rgroup = ggroup(horizontal=FALSE)
  gp = gpanedgroup(lgroup, rgroup, cont=container) # return this
  
  ## left group shows variable names
  add(lgroup,varNames,expand=TRUE)
  size(varNames) <- c(200,300)
  size(gp) <- c(450,350)
  ## right group shows options

  ## non layout for now
  ## new plot
  tmp = gframe("New plot", container=rgroup)
  add(tmp, newPlotSelector)

  ## show plots
  tmp = gframe("Current plot", container=rgroup)
  plotGroup = ggroup(container=tmp)
  add(plotGroup, prevPlot)
  add(plotGroup, curPlot)
  add(plotGroup, nextPlot)
  hg = ggroup(horizontal=FALSE, cont=plotGroup)
  add(hg, showCurPlotIcon)
  add(hg, showCurPlotName)

  
  ## add object
  tmp = gframe("add object to plot", container=rgroup)
  add(tmp,addObjectsSelector)

  ## list objects
##   tmp = gframe("Current object", container=rgroup)
##   objGroup = ggroup(container=tmp)
## #  add(objGroup, prevObject)
##   add(objGroup, curObject)
## #  add(objGroup, nextObject)
##   add(objGroup, showCurObject)

  

  tmp = gframe("Selections", container=rgroup)
  selGroup = ggroup(horizontal=FALSE,container=tmp)
  selButtonGroup = ggroup(cont=selGroup)
  add(selButtonGroup, getSelectedButton)
  add(selButtonGroup, setSelectedButton)
  add(selGroup, showSelected, expand=TRUE)


  #############################################
  ## actions
  ## plotselection
  addhandlerchanged(newPlotSelector,handler=function(h,...) {
    typeOfPlot = svalue(newPlotSelector)
    if(typeOfPlot == availPlots[1]) {
      return()                          # select plot choice
    }

    ## search through names of isets to set the proper iset


    
    varsIndex = svalue(varNames, index=TRUE)

    ## we have to fuss around to actually get the proper names into
    ## the plots.

    setISetByName(name)


    tmpEnvir = environment()
    
    x.name = ""; y.name = ""
    
    
    if(typeOfPlot == "ibox") {
      ## check for a factor
      if(length(varsIndex) == 2) {
        if(namesDF[varsIndex[1],2] == "factor") {
          x.name = dfnames[varsIndex[2]]
          assign(x.name,df[,varsIndex[2]], envir=tmpEnvir)
          y.name = dfnames[varsIndex[1]]
          assign(y.name,df[,varsIndex[1]], envir=tmpEnvir)
          theNewPlot = eval(parse(text=
            paste(typeOfPlot,"(",x.name,",",y.name,")")),
            envir=tmpEnvir)
        } else if(namesDF[varsIndex[2],2] == "factor") {
          x.name = dfnames[varsIndex[1]]
          assign(x.name,df[,varsIndex[1]], envir=tmpEnvir)
          y.name = dfnames[varsIndex[2]]
          assign(y.name,df[,varsIndex[2]], envir=tmpEnvir)
          theNewPlot = eval(parse(text=
            paste(typeOfPlot,"(",x.name,",",y.name,")")),
            envir=tmpEnvir)
        }
      } else {
        ## build up a data frame with proper names. do.call isn't
        ## doing this correctly
        lst = list()
        for(i in varsIndex) {
          lst[[dfnames[i]]] = df[,i]
        }
        lst = as.data.frame(lst)
        theNewPlot = ibox(lst)
      }
    } else {
      if(typeOfPlot %in% c("ibar","ihist")) {
        x.name = dfnames[varsIndex[1]]
        assign(x.name,df[,varsIndex[1]], envir=tmpEnvir)
        theNewPlot = eval(parse(text=
          paste(typeOfPlot,"(",x.name,")")),
          envir=tmpEnvir)
      } else if(typeOfPlot == "iplot") {
        x.name = dfnames[varsIndex[1]]
        assign(x.name,df[,varsIndex[1]], envir=tmpEnvir)
        y.name = dfnames[varsIndex[2]]
        assign(y.name,df[,varsIndex[2]], envir=tmpEnvir)
        theNewPlot = eval(parse(text=
          paste(typeOfPlot,"(",x.name,",",y.name,")")),
          envir=tmpEnvir)
      } else {
        ## imosaic, ihammock or ipcp
        ## TODO should check that pcp has only continuous vars

        lst = list()
        for(i in varsIndex) {
          lst[[dfnames[i]]] = df[,i]
        }
        lst = as.data.frame(lst)
        theNewPlot = switch(typeOfPlot,
          "imosaic"=imosaic(lst),
          "ipcp" = ipcp(lst)
          )
      }
    }

    ## record newPlot
    plotList = c(plotList, theNewPlot)

    svalue(newPlotSelector, index=TRUE) <- 1
  })


  ## selection
  addhandlerclicked(getSelectedButton,handler=function(h,...) {
    ## show selected in text box
    ## show wrapped in c()

    setISetByName(name)
    theSelected = try(iset.selected(),silent=TRUE)
    if(inherits(theSelected,"try-error"))
      theSelected = "c()"
    else
      theSelected = paste("c(",paste(theSelected,collapse=", "),")",sep="",collapse="")

    svalue(showSelected) <- theSelected

                    
  })

  addhandlerclicked(setSelectedButton, handler=function(h,...) {

    setISetByName(name)

    ## set selected from text box
    tmp = svalue(showSelected)
    tmp = gsub("\n","",tmp)
    val = try(eval(parse(text=tmp),envir=df),silent=TRUE)
    if(inherits(val,"try-error"))  {
      cat("Error with selection")
    } else {
      iset.select(val)
    }
  })

  ## plot selections
  addhandlerclicked(prevPlot,handler= function(h,...) {
    setISetByName(name)
    current = iplot.cur()
    if(current == 1)
      current = length(iplot.list())
    else
      current = current - 1
    iplot.set(current)
    updateCurrentPlotDescription()
  })
  addhandlerclicked(curPlot,handler= function(h,...) {
    setISetByName(name)
    updateCurrentPlotDescription()
  })
  addhandlerclicked(nextPlot,handler= function(h,...) {
    setISetByName(name)
    current = iplot.cur()
    if(current == length(iplot.list()))
      current = 1
    else
      current = current + 1
    iplot.set(current)
    updateCurrentPlotDescription()
    updateCurrentPlotDescription()
  })

  ## add objects
  addhandlerchanged(addObjectsSelector,handler=function(h,...) {
    setISetByName(name)

    ## we do different things based on request here
    addThis = svalue(addObjectsSelector)

    if(addThis == "") return()

    curPlotType = getCurrentPlotNameType()[2]
    if(addThis == "ilines") {
      ## give option to add to scatterplot, or provide x, y
      win = pmgWC$new("Add lines to current iplot")
      gp = ggroup(horizontal = FALSE, cont=win, raise.on.dragmotion = TRUE)
      if(curPlotType == "ixyplot") {
        spframe = gframe("Add trend line",horizontal=FALSE,cont=gp)
        varGroup = ggroup(container=spframe)
        glabel("x=",cont=varGroup)
        xVar = glabel("x-variable", cont=varGroup,editable=TRUE)
        adddroptarget(xVar)
        font(xVar) <-  c(style="bold")
        glabel(", ", cont=varGroup)
        glabel("y=",cont=varGroup)
        yVar = glabel("y-variable", cont=varGroup,editable=TRUE)
        adddroptarget(yVar)
        font(yVar) <-  c(style="bold")
        useSelected = gcheckbox("consider selected values only",cont=spframe)
        bgroup = ggroup(cont=gp)
        gbutton("Add regression line",cont=bgroup,
                handler=function(h,...) {
                  addTrendLine("lm")
                })
        gbutton("Add lowess line",cont=bgroup,
                handler=function(h,...) {
                  addTrendLine("lowess")
                })
        addTrendLine = function(type) {
          xvariable = svalue(xVar)
          yvariable = svalue(yVar)
          if(xvariable == "x-variable" ||
             yvariable == "y-variable") {
            cat("need to have two variables to add trend line\n")
            return(TRUE)
          }
          if(svalue(useSelected)) {
            theSelected = try(iset.selected(),silent=TRUE)
            if(inherits(theSelected,"try-error"))
              theSelected = 1:nrow(df)
            restDF = subset(df,select=c(xvariable,yvariable),
              subset=rep(TRUE,nrow(df))[theSelected])
          } else {
            restDF = subset(df,select=c(xvariable,yvariable))
          }
          if(type == "lm") {
            res = lm(restDF[,2] ~ restDF[,1])
            iabline(res)
          } else if(type == "lowess") {
            ilines(lowess(restDF[,1], restDF[,2]))
          }
        }
      }
      ## now offer to add lines
      slgp = gframe("Specify line to add",cont=gp)
      addThese = gedit("",cont=slgp)
      gbutton("add",cont=slgp,handler=function(h,...) {
        eval(parse(text=paste("ilines(",svalue(addThese),")")),envir=df)
      })
      delGroup = ggroup(cont=gp)
      addSpring(delGroup)
      gbutton("cancel",cont=delGroup, handler=function(h,...) dispose(win))
    } else if(addThis == "iabline") {
      ## FIXME
      cat("That action needs to be programmed.")
    } else if(addThis == "itext") {
      ## FIXME
      cat("That action needs to be programmed.")
    } else if(addThis == "remove last added") {
      iobj.rm()
    } else {
      cat("That action needs to be programmed.")
    }
    svalue(addObjectsSelector, index=1) <- 1
  })


  ## current objects
##   addhandlerclicked(prevObject,handler=function(h,...) {
##     ## now way to set
##     updateCurrentObjectType()    
##   })
  addhandlerclicked(curObject,handler=function(h,...) {
    x = iobj.cur()
    cur = .jstrVal(x$obj)                 # from print.iobj
    svalue(showCurObject) <- cur
  })
##   addhandlerclicked(prevObject,handler=function(h,...) {
##     current = iobj.cur()
##     current = ifelse(current ==  length(iobj.list()),1,current+1)
##     updateCurrentObjectType()
##   })

  
  ##################################################
  ## helpers
  getCurrentPlotNameType = function() {
    curDetails = iplot.list()[[iplot.cur()]]
    theType = class(curDetails)[2]
    theName = attr(curDetails,"iname")
    return(c(theName,theType))
  }
  updateCurrentPlotDescription = function() {
    ## update label and icon to match current
    curDetails = getCurrentPlotNameType()
    ## do icon
    switch(curDetails[2],
           "ibar"=svalue(showCurPlotIcon) <- "barplot",
           "ihist"=svalue(showCurPlotIcon) <- "hist",
           "ibox"=svalue(showCurPlotIcon) <- "boxplot",
           "imosaic"=svalue(showCurPlotIcon) <- "plot1",
           "ipcp"=svalue(showCurPlotIcon) <- "plot1",
           "iplot"=svalue(showCurPlotIcon) <- "points" 
           )
    ## do label
    svalue(showCurPlotName) <- curDetails[1]
    return(TRUE)                        # for handlers
  }

  ## obj
  updateCurrentObjectType = function() {
  }

  
  ## return container
  return(gp)
}
  

pmg.iplots = function(container = pmgWC$new("PMG: iplots interface"), envir=.GlobalEnv) {

  do.call("require",list("iplots"))                       # load if not loaded
  

  ## we have name, data. Now set up a new iset for this.
  
  group = ggroup(horizontal = FALSE, container=container)
  ## simple toolbar
  tbl = list()
  tbl$Add$icon="add"
  tbl$Add$handler= function(...) addNewDF()
  tbl$Quit$icon = "quit"
  tbl$Quit$handler = function(...) dispose(group)
    
  gtoolbar(tbl, cont=group)

  ## notebook
  nb = gnotebook()
  add(group, nb, expand=TRUE)
  ## add instructions
  theInstructions = pmgIplotInstructions()
  size(theInstructions) <- c(450,350)
  add(nb,theInstructions,label="help")
  

  addNewDF = function() {

    ## grab data set names
    objs = ls(envir=.GlobalEnv)
    addDfs = objs[sapply(objs, function(i)
      is.data.frame(get(i, envir=envir)))]
    
    if(length(addDfs) > 0) {
      win = pmgWC$new("Make a new iset around this data frame")
      gp = ggroup(horizontal=FALSE, cont=win)
      add(gp, glabel("Double click on a data frame"))
      
      dfSelector = gtable(addDfs)
      add(gp, dfSelector, expand=TRUE)
      addhandlerdoubleclick(dfSelector,handler = function(h,...) {
        theDF = svalue(dfSelector) ## its name
        df = get(theDF, envir=envir)    # its values
        add(nb,.newSet(df,theDF), label=theDF)
        dispose(win)
      })
    } else {
      gmessage("No data frames available.")
    }
  }
}
  
  
pmgIplotInstructions = function() {
  instructs = gtext()
  add(instructs,"iplots usage", font.attr=c("bold","blue"))
  add(instructs,
      paste("The iplots website says this about the the package:",
            "",
            "\"(it) offers a wide variety of plots, including histograms,",
            "barcharts, scatterplots, boxplots, fluctuation diagrams,",
            "parallel coordinates plots and spineplots. All plots support",
            "interactive features, such as querying, linked highlighting,",
            "color brushing, and interactive changing of parameters.\"",
            "",
            "The pmg interface alows one to create new plots by selecting",
            "from a popup box. After choosing a data frame, and selecting the",
            "variables for the new graphic, simplify changing the ",
            "popup box will produce a new graphic.",
            "There is some functionality for adding a line or text to ",
            "the current graphic. Like other R devices, there is a",
            "current plot device. These may be cycled through by",
            "clicking the buttons.",
            sep="\n",collapse="")
      )
                       

    return(instructs)
}
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.loadPackages.R"
getPackages = function(...) {
  allPackages = .packages(all.available=TRUE)
  loaded = allPackages %in% .packages()
  data.frame(Package=allPackages, loaded=loaded, stringsAsFactors=FALSE)
}


pmg.loadPackages = function(width=300, height=400) {

  win = pmgWC$new("Load or detach packages", v=T)
  size(win) <- c( width, height)
  group = ggroup(horizontal=FALSE, container=win, expand=TRUE)


  packageHandler = function(obj) {
    packages = svalue(packageList, drop=FALSE)
    for(i in 1:nrow(packages)) {
      package = packages[i,1]              # character
      installed = packages[i,2]                # logical
      if(installed == TRUE) {
        cat("Detach",package,"\n")
        svalue(status) <- Paste("detach package ",package)
        pkg = Paste("package:",package)       # see help on detach
        detach(pos = match(pkg, search()))
        svalue(status)
      } else {
        svalue(status) <- Paste("Load package ",package)
        res = require(package, character.only=TRUE)
        if(res == FALSE)
          cat(Paste("Couldn't load package",package,"\n"))
        else
          cat("Loaded package ",package,"\n")
        svalue(status)
      }
    }
    ## updata package list, 
    packageList[,] = getPackages()
  }

  ## store package into a separate group -- can update
  packageGroup = ggroup(container=group, expand=TRUE)
  packageList = gtable(getPackages(),
    multiple=TRUE, sort.columns = 1:2,
    handler = function(h,...) {
      packageHandler(h$obj)
    },
    container=packageGroup, expand=TRUE)

  buttonGroup = ggroup(container=group)
  addSpring(buttonGroup)
#  gbutton("ok",handler = function(h,...) packageHandler(h$action),
#          action=packageList, container=buttonGroup)
  gbutton("cancel",container=buttonGroup, handler = function(h,...) dispose(win))

  status = gstatusbar("Double click on  package to load/detach",container=group)
  
    
}
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.modelsmenu.R"
### data for model dialogs


lm.list = list(
  title = "lm()",
  help = "lm",
  type = "text",                      # either text or graphic
  variableType = "model",
  assignto = TRUE,
  action = list(
    beginning = "lm(",
    ending = ")"
    ),
  arguments = list(
    arguments =list(
      weights = EMPTY.list,
      offset = EMPTY.list,
      "..."=EMPTY.list
      )
    )
  )

aov.list = list(
  title = "aov()",
  help = "aov",
  action = list(
    beginning = "aov(",
    ending = ")"
    ),
  variableType = "model",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      projections = FALSE.list,
      qr = FALSE.list,
      contrasts = EMPTY.list,
      "..."=EMPTY.list
      )
    )
  )

lqs.list = list(
  title = "lqs()",
  help = "lqs",
  action = list(
    beginning = "require(MASS);lqs(",
    ending = ")"
    ),
  variableType = "model",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      method = list(
        type = "gdroplist",
        items = c('"lts"', '"lqs"', '"lms"', '"S"', '"model.frame"')
        ),
      model = TRUE.list,
      x.ret = FALSE.list,
      y.ret = FALSE.list,
      contrasts = EMPTY.list,
      "..." = EMPTY.list
      )
    )
  )



glm.list = list(
  title = "glm()",
  help = "glm",
  action = list(
    beginning = "glm(",
    ending = ")"
    ),
  variableType = "model",           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      family = list(
        type = "gdroplist",
        items = c(
          '"binomial(link = \'logit\')"',
          '"gaussian(link = \'identity\')"',
          '"Gamma(link = \'inverse\')"',
          '"inverse.gaussian(link = \'1/mu^2\')"',
          '"poisson(link = \'log\')"',
          '"quasi(link = \'identity\', variance = \'constant\')"',
          '"quasibinomial(link = \'logit\')"',
          '"quasipoisson(link = \'log\')"'
          )
        ),
      method = list(
        type = "gdroplist",
        items = c('"glm.fit"','"model.frame"')
        ),
      contrasts = EMPTY.list,
      weights = EMPTY.list
      ),
    "Starting points"=list(
      start = NULL.list,
      blank = BLANK.list,
      etastart = EMPTY.list,
      mustart = EMPTY.list
      )
    )
  )

### model selection

anova.list = list(
  title = "anova()",
  help = "anova",
  action = list(
    beginning = "anova(",
    ending = ")"
    ),
  variableType = NULL,           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    "Model objects" = list(                   # types in genericWidget
      objects = list(
        type="geditlist",
        text = "",
        wideBody=TRUE
        )
      )
    )
  )

## stepAIC
stepAIC.list = list(
  title = "stepAIC()",
  help = "stepAIC",
  action = list(
    beginning = "require(MASS);stepAIC(",
    ending = ")"
    ),
  variableType = NULL,           # uni/bi/model/lattice
  type = "text",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    "Model object" = list(                   # types in genericWidget
            object = EMPTY.list
            ),
    arguments = list(
      scope = EMPTY.list,
      direction = list(
        type = "gdroplist",
        items = c('"both"','"backward"','"forward"')
        ),
      scale = EMPTY.list,
      k = list(
        type = "gedit",
        text = 2
        )
      )
    )
  )


## mixed effects models
corClasses.list = list(
  type = "gdroplist",
  items = 
  c("",                                 # NULL
    "corAR1(value=0,form=~1)",
    "corARMA(value=p+q, form=~1, p=0, q=0)",
    "corCAR1(value=0.2, form=~1)",
    "corCompSymm(value=0, form=~1)",
    "corExp(value=0, form=~1, nugget=FALSE, metric='euc')",
    "corGaus(value=0, form=~1, nugget=FALSE, metric='euc')",
    "corLin(value=0, form=~1, nugget=FALSE, metric='euc')",
    "corRatio(value=0, form=~1, nugget=FALSE, metric='euc')",
    "corSpher(value=0, form=~1, nugget=FALSE, metric='euc')",
    "corSymm(value=0, form=~1)"
    )
)

varFunc.list = list(
  type = "gdroplist",
  items = c("",
    "varFunc(OBJECT)"
    )
  )
  ## could really imporove the weights, correlation stuff
gls.list = list(
  title = "gls()",
  help = "gls",
  type = "text",                      # either text or graphic
  variableType = "model",
  assignto = TRUE,
  action = list(
    beginning = "require(nlme);gls(",
    ending = ")"
    ),
  arguments = list(
    arguments =list(
      correlation = corClasses.list,
      weights = varFunc.list
      )
    )
  )

lmList.list = list(
  title = "lmList()",
  help = "lmList",
  type = "text",                      # either text or graphic
  variableType = "lattice",
  assignto = TRUE,
  action = list(
    beginning = "require(nlme);lmList(",
    ending = ")"
    ),
  arguments = list(
    arguments =list(
      correlation = corClasses.list,
      weights = varFunc.list
      )
    )
  )



lme.list = list(
  title = "lme()",
  help = "lme",
  type = "text",                      # either text or graphic
  variableType = "lmer",
  assignto = TRUE,
  action = list(
    beginning = "require(nlme);lme(",
    ending = ")"
    ),
  arguments = list(
    arguments =list(
      correlation = corClasses.list,
      weights = varFunc.list,
      method = list(
        type = "gdroplist",
        items = c('"REML"','"ML"')
        )
      )
    )
  )

## diagnostics
## lm is lame, just put par(mfrow=c(2,2)) in front, and replace
lm.diagnostics.list = list(
  title = "plot.lm()",
  help = "plot.lme",
  type = "graphic",                      # either text or graphic
  variableType = "univariate",          # this wants x=
  assignto = NULL,
  action = list(
    beginning = "tmp=par(\"mfrow\");par(mfrow=c(2,2));plot.lm(",
    ending = ");par(mfrow=tmp)"
    )
  )
## lme diagnositics
plot.lme.diagnostics.list = list(
  title = "plot.lme()",
  help = "plot.lme",
  type = "graphic",                      # either text or graphic
  variableType = "univariate",          # this wants x=
  assignto = NULL,
  action = list(
    beginning = "require(nlme);plot(",
    ending = ")"
    ),
  arguments = list(
    arguments =list(
      form = list(
        type = "gradio",
        index = FALSE,
        items = c(
          "",
          "resid(., type=\"p\") ~ fitted(.)",
          "resid(.) ~ fitted(.)",
          "getGroups(.) ~ resid(.,type=\"p\")", 
          "getGroups(.) ~ resid(.)", 
          "getResponse(.) ~ fitted(.)",
          "resid(., type=\"p\") ~ fitted(.) | getGroups(.)"
          ),
        wideBody = TRUE
        ),
      abline = EMPTY.list,
      grid = list(
        type="gdroplist",
        items = c("","FALSE","TRUE")
        )
      )
    )
  )

qqnorm.lme.diagnostics.list = list(
  title = "qqnorm.lme()",
  help = "qqnorm.lme",
  type = "graphic",                      # either text or graphic
  variableType = "univariate",          # this wants x=
  assignto = NULL,
  action = list(
    beginning = "require(nlme);qqnorm(",
    ending = ")"
    ),
  arguments = list(
    arguments =list(
      form = list(
        type = "gradio",
        index = FALSE,
        items = c(
          "",
          "~ resid(.)",
          "~ resid(., type=\"p\")",
          "~ resid(.) |  getGroups(.)",
          "~ resid(., type=\"p\") | getGroups(.)",
          "~ ranef(.)",
          "~ ranef(.) | getGroups(.)"
          ),
        wideBody = TRUE
        ),
      abline = EMPTY.list,
      grid = list(
        type="gdroplist",
        items = c("","FALSE","TRUE")
        )
      )
    )
  )

pairs.lme.diagnostics.list = list(
  title = "pairs.lme()",
  help = "pairs.lme",
  type = "graphic",                      # either text or graphic
  variableType = "univariate",          # this wants x=
  assignto = NULL,
  action = list(
    beginning = "require(nlme);pairs(",
    ending = ")"
    ),
  arguments = list(
    arguments =list(
      form = list(
        type = "gradio",
        index = FALSE,
        items = c(
          "",
          "~ coef(.)",
          "~ ranef(.) | getGroups(.)"
          ),
        wideBody = TRUE
        ),
      abline = EMPTY.list,
      grid = list(
        type="gdroplist",
        items = c("","FALSE","TRUE")
        )
      )
    )
  )
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.options.R"
pmg.options = function(...) {
  gmessage("Needs to be written.", icon="error")
}
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.plotmenu.R"
### this file synchronizes with menes.R
### this one provides the widget.list stuff

par.setup.list = list(
  title = "par()",
  help = "par",
  type = NULL,                      # either text or graphic
  variableType = NULL,
  assignto = NULL,
  action = list(
    beginning = "par(",
    ending = ")"
    ),
  arguments = list(
    Setup= list(
      bty = list(
        type="gdroplist",
        items = c('','"o"', '"l"', '"7"','"c"', '"u"',  '"]"')
        ),
      pty = list(
        type="gdroplist",
        items=c('','"s"','"m"')
        ),
      xpd=list(
        type="gdroplist",
        items=c("","TRUE","FALSE","NA")
        )
      )
    )
  )

par.axes.list = list(
  title = "par()",
  help = "par",
  type = NULL,                      # either text or graphic
  variableType = NULL,
  assignto = NULL,
  action = list(
    beginning = "par(",
    ending = ")"
    ),
  arguments = list(
    axes=list(
      xaxt = list(
        type="gdroplist",
        items=c("",'"s"','"n"')
        ),
      yaxt = list(
        type="gdroplist",
        items=c("",'"s"','"n"')
        ),
      xlog = emptyTRUE.list,
      ylog = emptyTRUE.list,
      las = list(
        type="gdroplist",
        items=c("",0,1,2,3)
        )
      )
    )
  )
par.colors.list = list(
  title = "par()",
  help = "par",
  type = NULL,                      # either text or graphic
  variableType = NULL,
  assignto = NULL,
  action = list(
    beginning = "par(",
    ending = ")"
    ),
  arguments = list(
    colors=list(
      bg=default.color.list,
      fg=default.color.list,
      col.main=default.color.list,
      col.sub=default.color.list,
      col.axis=default.color.list,
      col.lab=default.color.list
      )
    )
  )

par.fonts.list = list(
  title = "par()",
  help = "par",
  type = NULL,                      # either text or graphic
  variableType = NULL,
  assignto = NULL,
  action = list(
    beginning = "par(",
    ending = ")"
    ),
  arguments = list(
    fonts = list(
      family = list(
        type="gdroplist",
        items=c("",'"serif"', '"sans"', '"mono"','"symbol"')
        ),
      font = list(
        type="gdroplist",
        items=c("",1,2,3,4)
        )
      ),
    margins=list(
      mar = list(
        type="gedit",
        text=""
        )
      )
    )
  )

par.onfigures.list = list(
  title = "par()",
  help = "par",
  type = NULL,                      # either text or graphic
  variableType = NULL,
  assignto = NULL,
  action = list(
    beginning = "par(",
    ending = ")"
    ),
  arguments = list(
    "Number of figures"=list(
      mfrow=EMPTY.list
      )
    )
  )


##$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
## Univariate

barplot.list = list(
  title = "univariate barplot()",
  help = "barplot",
  type = "graphic",                      # either text or graphic
  variableType = "univariatetable",
  variableTypeExtra = list(name="xlabel",value="height"),
  action = list(
    beginning = "barplot(",
    ending = ")"
    ),
  arguments = list(
    adjustments = list(
      width=list(
        type = "gedit",
        text = "1",
        coerce.with=as.numeric
        ),
      horiz= FALSE.list
      ),
    labels = labels.list
    )
  )

piechart.list = list(
  title = "pie()",
  help = "pie",
  type = "graphic",                      # either text or graphic
  variableType = "univariatetable",
  action = list(
    beginning = "pie(",
    ending = ")"
    ),
  arguments = list(
    adjustments = list(
      labels=list(
        type = "gedit",
        text = "names(x)"
        ),
      clockwise= FALSE.list
      ),
    labels = labels.list
    )
  )


univariate.boxplot.list = list(
  title = "boxplot()",
  help = "boxplot",
  type = "graphic",                      # either text or graphic
  variableType = "univariate",
  action = list(
    beginning = "boxplot(",
    ending = ")"
    ),
  arguments = list(
    adjustments = list(
      horizontal= FALSE.list,
      add= FALSE.list,
      notch = FALSE.list,
      varwidth = FALSE.list,
      col = default.color.list
      ),
    labels = labels.list
    )
 )


## other boxplots are similar
model.boxplot.list = bivariate.boxplot.list = univariate.boxplot.list
bivariate.boxplot.list$variableType="bivariate"
model.boxplot.list$variableType="model"


bivariate.boxplot.list = list(
  title = "boxplot()",
  help = "boxplot",
  type = "graphic",                      # either text or graphic
  variableType = NULL,
  action = list(
    beginning = "boxplot(",
    ending = ")"
    ),
  arguments = list(
    data = list(
      x = list(
        type="gedit"
        ),
      "..."=list(
        type="gedit"
        )
      ),
    adjustments = list(
      horizontal= FALSE.list,
      add= FALSE.list,
      notch = FALSE.list,
      varwidth = FALSE.list,
      col = default.color.list
      ),
    labels = labels.list
    )
 )






##
hist.list = list(
  title = "hist()",
  help = "hist",
  action = list(
    beginning = "hist(",
    ending = ")"
    ),
  type = "graphic",                      # either text or graphic
  variableType = "univariate",
  arguments = list(
    adjustments = list(
      breaks= list(
        type="gdroplist",
        items=c("\"Sturges\"","\"Scott\"","\"Friedman-Diaconis\"")
        ),
      probability = TRUE.list,
      include.lowest = TRUE.list,
      right = TRUE.list,
      density = NULL.list,
      angle = list(
        type="gedit",
        text="45"
        ),
      border = EMPTY.list,
      col = default.color.list,
      main = EMPTY.list      
      )
    )
  )


densityplot.list = list(
  title = "density()",
  help = "density",
  action = list(
    beginning = "plot(density(",
    ending = "))"
    ),
  type = "graphic",                      # either text or graphic
  variableType = "univariate",
  arguments = list(
    adjustments = list(
      bw = list(
        type = "gdroplist",
        items = c("\"nrd0\"","\"nrd\"","\"ucv\"","\"bcv\"","\"SJ\"")
        ),
      adjust = list(
        type = "gedit",
        text = 1
        ),
      kernel = list(
        type = "gdroplist",
        items = c("\"gaussian\"", "\"epanechnikov\"", "\"rectangular\"", "\"triangular\"", "\"biweight\"", "\"cosine\"", "\"optcosine\"")
        )
      )
    )
  )

qqnorm.list = list(
  title = "qqnorm()",
  help = "qqnorm",
  action = list(
    beginning = "qqnorm(",
    ending = ")"
    ),
  type = "graphic",                      # either text or graphic
  variableType = "univariate",
  arguments = list(
    adjustments = list(
      xlab = EMPTY.list,
      ylab = EMPTY.list
      )
    )
  )


##################################################
## add to graphic
"add.points.list" = list(
  title = "points()",
  help = "points",
  action = list(
    beginning = "points(",
    ending = ")"
    ),
  type = "graphic",                      # either text or graphic
  variableType = "bivariate",
  arguments = list(
    adjustments = list(
      col = default.color.list,
      pch = list(
        type = "gedit",
        text = "1"
        )
      )
    )
  )

"add.lines.list" = list(
  title = "lines()",
  help = "lines",
  action = list(
    beginning = "lines(",
    ending = ")"
    ),
  type = "graphic",                      # either text or graphic
  variableType = "bivariate",
  arguments = list(
    adjustments = list(
      col = default.color.list,
      lty = lty.list
      )
    )

  )
"add.density.list" = list(
  title = "add density()",
  help = "density",
  action = list(
    beginning = "lines(density(",
    ending = "))"
    ),
  type = "graphic",                      # either text or graphic
  variableType = "univariate",
  arguments = list(
    adjustments = list(
      bw = list(
        type = "gdroplist",
        items = c("\"nrd0\"","\"nrd\"","\"ucv\"","\"bcv\"","\"SJ\"")
      ),
      adjust = list(
        type = "gedit",
        text = 1
        ),
      kernel = list(
        type = "gdroplist",
        items = c("\"gaussian\"", "\"epanechnikov\"", "\"rectangular\"", "\"triangular\"", "\"biweight\"", "\"cosine\"", "\"optcosine\"")
        )
      )
    )

  )


## curve adds a function
"add.curve.list" = list(
  title = "curve()",
  help = "curve",
  action = list(
    beginning = "curve(",
    ending = "))"
    ),
  type = "graphic",                      # either text or graphic
  variableType = NULL,
  arguments = list(
    arguments = list(
      expr = EMPTY.list,
      label = list(
        type= "glabel",
        text = "An expression in x or name"
        ),
      add = TRUE.list,
      label = list(
        type= "glabel",
        text = "Either add or specify limits"
        ),
      from = EMPTY.list,
      to   = EMPTY.list
      )
    )
  )

rug.list = list(
  title = "rug()",
  help = "rug",
  action = list(
    beginning = "rug(",
    ending = ")"
    ),
  type = "graphic",                      # either text or graphic
  variableType = "univariate",
  arguments = list(
    adjustments = list(
      ticksize = list(
        type = "gedit",
        text = "0.03"
        ),
      side = list(
        type = "gedit",
        text = "1"
        ),
      lwd = list(
        type = "gedit",
        text = "0.5"
        ),
      col = default.color.list
      )
    )
  )


title.list =  list(
  title = "title()",
  help = "title",
  action = list(
    beginning = "title(",
    ending = ")"
    ),
  variableType = NULL,           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    labels = labels.list
    )
  )



##################################################
## bivariate

scatterplot.list =  list(
  title = "plot()",
  help = "plot",
  action = list(
    beginning = "plot(",
    ending = ")"
    ),
  variableType = "bivariate",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    type = list(
      type = "gdroplist",
      items = c('"p"','"l"','"b"','"c"','"o"','"h"','"s"','"S"')
      ),
    pch = pch.list,
    cex = EMPTY.list,
    col = default.color.list,
    labels = labels.list
    )
  )
  

## sunflower plot

sunflowerplot.list =  list(
  title = "sunflowerplot()",
  help = "sunflowerplot",
  action = list(
    beginning = "sunflowerplot(",
    ending = ")"
    ),
  variableType = "bivariate",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    "plot type" = list(                   # types in genericWidget
      pch = list(
        type = "gedit",
        text = "16"
        ),
      col = default.color.list
      ),
    "Sizes" = list(
      cex = list(
        type = "gedit",
        text = "0.8"
        ),
      size = list(
        type = "gedit",
        text = "1/8"
        ),
      seg.col = list(
        type = "gedit",
        text = "2"
        ),
      seg.lwd = list(
        type = "gedit",
        text = "1.5"
        )
      ),
    labels = labels.list
    )
  )


## qqplot
qqplot.list =  list(
  title = "qqplot()",
  help = "qqplot",
  action = list(
    beginning = "qqplot(",
    ending = ")"
    ),
  variableType = "bivariate",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    "plot type" = list(                   # types in genericWidget
      pch = list(
        type = "gedit",
        text = "16"
        ),
      col = default.color.list
      ),
    "Sizes" = list(
      cex = list(
        type = "gedit",
        text = "0.8"
        )
      ),
    labels = labels.list
    )
  )


### model plots
pairs.list =  list(
  title = "pairs()",
  help = "pairs",
  action = list(
    beginning = "pairs(",
    ending = ")"
    ),
  type = "graphic",                      # either text or graphic
  variableType = "univariate",
  arguments = list(
    labels = labels.list
    )
  )




###
stripchart.list = list(
  title = "stripchart()",
  help = "stripchart",
  action = list(
    beginning = "stripchart(",
    ending = ")"
    ),
  variableType = NULL,           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    variables = list(
      x = list(
        type="geditnamedlist",
        text = ""
        )
      ),
    arguments = list(                   # types in genericWidget
      method = list(
        type = "gdroplist",
        items = c('"stack"','"jitter"','"overplot"')
        ),
      vertical = FALSE.list,
      jitter = list(
        type="gedit",
        text = 0.1
        ),
      offset = list(
        type="gedit",
        text = "1/3"
        ),
      add = FALSE.list,
      at = EMPTY.list
      ),
    "settings" = list(
      xlim = EMPTY.list,
      ylim = EMPTY.list,
      pch = pch.list,
      cex = EMPTY.list,
      col = default.color.list
      )
    )
  )

## dotchart
dotchart.list = list(
  title = "dotchart()",
  help = "dotchart",
  action = list(
    beginning = "dotchart(",
    ending = ")"
    ),
  variableType = "univariate",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      labels = NULL.list,
      groups = NULL.list,
      gdata = NULL.list
      ),
    "plot arguments" = list(
      pch = list(
        type = "gedit",
        text  = 21
        ),
      gpch = list(
        type = "gedit",
        text  = 21
        ),
      cex = EMPTY.list,
      bg = EMPTY.list,
      color = EMPTY.list,
      gcolor = EMPTY.list,
      lcolor = EMPTY.list,
      xlim = EMPTY.list
      ),
    "labels" = labels.list
    )
  )

## cumulative distribution plot. Define function to slip in plot arguments
plotecdf = function(x,ylab="Fn(x)",verticals=FALSE,col.01line="gray70") {
  plot(ecdf(x), ylab=ylab, verticals = verticals, col.01line = col.01line)
}

ecdf.list = list(
  title = "ecdf()",
  help = "ecdf",
  action = list(
    beginning = "plotecdf(",
    ending = ")"
    ),
  variableType = "univariate",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = TRUE,                      # TRUE for assignto
  arguments = list(
    "plot arguments" = list(
      ylab = list(
        type = "gedit",
        text  = "'Fn(x)'"
        ),
      verticals=FALSE.list,
      col.01 = "'gray70'"
      )
    )
  )

scatterplot.model.list =  list(
  title = "plot()",
  help = "plot",
  action = list(
    beginning = "plot(",
    ending = ")"
    ),
  variableType = "model",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      type = list(
        type = "gdroplist",
        items = c('"p"','"l"','"b"','"c"','"o"','"h"','"s"','"S"')
        ),
      pch = pch.list,
      cex = EMPTY.list,
      col = default.color.list
      ),
    labels = labels.list
    )
  )
  



##################################################
## lattice stuff
xyplot.list = list(
  title = "xyplot()",
  help = "xyplot",
  action = list(
    beginning = "require(lattice);xyplot(",
    ending = ")"
    ),
  variableType = "lattice",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      panel = EMPTY.list
      ),
    jitter = list(      jitter = FALSE.list,
      factor = EMPTY.list
      ),
    labels = labels.list
    )
  )

## dotplot
dotplot.list = list(
  title = "dotplot()",
  help = "dotplot",
  action = list(
    beginning = "require(lattice);dotplot(",
    ending = ")"
    ),
  variableType = "lattice",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      panel = EMPTY.list
      ),
    jitter = list(
      jitter = FALSE.list,
      factor = EMPTY.list
      ),
    labels = labels.list
    )
  )


## barchart
barchart.list = list(
  title = "barchart()",
  help = "barchart",
  action = list(
    beginning = "require(lattice);barchart(",
    ending = ")"
    ),
  variableType = "lattice",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      panel = EMPTY.list
      ),
    jitter = list(
      jitter = FALSE.list,
      factor = EMPTY.list
      ),
    labels = labels.list
    )
  )

## stripplot
stripplot.list = list(
  title = "stripplot()",
  help = "stripplot",
  action = list(
    beginning = "require(lattice);stripplot(",
    ending = ")"
    ),
  variableType = "lattice",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      panel = EMPTY.list
      ),
    jitter = list(
      jitter = FALSE.list,
      factor = EMPTY.list
      ),
    labels = labels.list
    )
  )

## bwplot
bwplot.list = list(
  title = "bwplot()",
  help = "bwplot",
  action = list(
    beginning = "require(lattice);bwplot(",
    ending = ")"
    ),
  variableType = "lattice",           # uni/bi/model/lattice
  type = "graphic",                        # either text or graphic
  assignto = NULL,                      # TRUE for assignto
  arguments = list(
    arguments = list(                   # types in genericWidget
      panel = EMPTY.list
      ),
    jitter = list(
      jitter = FALSE.list,
      factor = EMPTY.list
      ),
    labels = labels.list
    )
  )

#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.teachingDemos.R"
### Demos:
## histogram -- select bins
## binomial
## normal sampling -- clt
## confidence intervals
## power
## probability calculator
## 
#### IMPLEMENT ME:
## bootstrap
## robustness of regression line

## some in YN.R from Yvonnick Noel yvonnick.noel@uhb.fr


pmgDemo = function(lst, container=NULL) {

  showHelp = function(txt) {
    gmessage(txt)
  }
  
  tmpfile = tempfile()
  
  ## lst is a list with components
  ## widgets
  ## function to draw to a file
  ##

  group = ggroup(container=container)
  lgroup = ggroup(horizontal=FALSE)
  rgroup = ggroup()
  add(group, gpanedgroup(lgroup, rgroup), expand=TRUE)

  ##
  graphic = gimage(); add(rgroup, graphic, expand=TRUE)
  size(graphic) <- c(480,480)
  ## lgroup
  tbl = glayout()
  ctr = 1
  for(i in names(lst$widgets)) {
    tbl[ctr,1] <- glabel(i)
    tbl[ctr,2] <- lst$widgets[[i]]
    ctr <- ctr + 1
  }
  tbl[ctr,2] <- gbutton("help",handler = function(h,...) {
    showHelp(lst$help)
  })
  add(lgroup, tbl)
  visible(tbl) <- TRUE


  ## add the callback  
  theCallback = function(...) {
    file = do.call(lst$f, list(file = tmpfile, lapply(lst$widgets,svalue)))
    svalue(graphic) <- file
  }
  sapply(lst$widgets, function(i) addhandlerchanged(i, handler = theCallback))
  
  ## call callback
  theCallback(file, lapply(lst$widgets,svalue))
  return(group)
}

##################################################



templateForDemo = list(
  widgets = list(

    ),
  f = function(file, valLst) {
    png(file, width=480, height=480)
    on.exit(dev.off())

    return(file)
  },
  help = paste(
    "",
    collapse = "\n")
  )





## open a window showing the possible demos
pmg.teachingDemos = function(...) {

  ### This is really annoying, but to avoid calling these when defining the list, I put them inside this function
histogramDemo = list(
  widgets = list(
    "data set" = gedit(""),
    "% no. bins" = gslider(from=0.01,to=1, by = 0.01, value=.5)
    ),
  f = function(file, valList) {
    dataSetName = valList[[1]]
    dataSet = svalue(dataSetName)
    if(is.na(dataSetName) || dataSetName == "")
      return(file)

    noBins = as.integer(length(dataSet)*as.numeric(valList[[2]]))
    noBins = max(1, noBins)
    
    png(file, width=480, height=480)
    on.exit(dev.off())

    theTitle = paste(noBins,"bins and ", length(dataSet),"observations" )
    
    require(lattice)
    print(histogram(dataSet, nint=noBins, xlab=theTitle))
    
    return(file)
  },
  help = paste("Histogram:\n",
    "Drag or type in variable name containing data set",
    " adjust slider to adjust number of bins as a proportion of sample size."
    )
  )
### confidence intervals
confIntervalDemo = list(
  widgets = list(
    mu = gedit("0", coerce.with=as.numeric),
    sigma = gedit("1", coerce.with=as.numeric),
    n = gedit("10", coerce.with=as.numeric),
    "Conf. level" = gradio(c(.80,0.90,0.95), selected=3),
    "No intervals" = gradio(c(10,25,50,100)),
    "Resample" = gbutton("again")
    ),
  f = function(file, valList) {
    mu = valList[[1]]
    sigma = valList[[2]]
    n = valList[[3]]
    confLevel = valList[[4]]
    noIntervals = valList[[5]]

    m = noIntervals
    
    res = matrix(NA,nrow=2,ncol=m)
    for(i in 1:m) res[,i]= t.test(rnorm(n,mu,sigma),conf.level=confLevel)$conf.int
    
    missed = 1 + (res[1,] >= mu | res[2,] <= mu)

    png(file, width = 480, height = 480)
    on.exit(dev.off())

    
    ## make plot
    matplot(res,rbind(1:m,1:m)/m,
          type="l",
          col=c("black","red")[missed],
          lwd=missed,
          lty=missed,
          yaxt="n",
          xlab="",ylab="",
          main=paste(m," ",100*confLevel,"% confidence intervals")  
           )
    abline(v=mu)

    return(file)
  },
  help = paste(
    "Demo of confidence intervals.",
    "Adjust parameters or click 'new sample' to draw a new sample.",
    "The graphic illustrates several simulated confidence intervals. Those",
    "that do not contain the true parameter are flagged.",
    collapse = "\n"
    )

  )

##################################################
CLTDemo = list(
  widgets = list(
    Distribution = gradio(c("Normal","Long tailed","Skewed")),
    n = gslider(from=5,to=50,by=5, value=10),
    m = gslider(from=5,to=25,by=2, value=10),
    Statistic = gradio(c("mean","median")),
    Resample = gbutton("again")
    ),
  f = function(file, valLst) {
    png(file, width=480, height=480)
    on.exit(dev.off())

    Distribution = valLst$Distribution
    n = valLst$n
    m = valLst$m
    Statistic = valLst$Statistic

    
    switch(Distribution,
           "Normal" = {
             curve(dnorm(x), from=-3, to = 3, lwd=2)
             abline(v=0)
           },
           "Long tailed" = {
             curve(dt(x,df=3), from = -3.5, to = 3.5, lwd=2)
             abline(v=0)
           },
           "Skewed" = {
             curve(dexp(x), from = 0, to = 3, lwd=2)
             if(Statistic == "mean")
               abline(v=1)
             else
               abline(v=0.69)
           })

    ySize = switch(Distribution,
      "Normal" = .4,
      "Long tailed" = .4,
      "Skewed" = 1
      )


    ## Now draw the samples
    tmp = numeric(m)
    for(i in 1:m) {
      theSample = switch(Distribution,
        "Normal" = rnorm(n),
        "Long tailed" = rt(n,df=3),
        "Skewed" = rexp(n)
        )
      y = i*ySize/m
      points(theSample, rep(y, n), col=gray(.6))
      tmp[i] = do.call(Statistic, list(theSample))
      points(tmp[i], y, pch=17, cex=2,col=gray(.8)) # lighter
    }

    ## plot sample at bottom with rug
    rug(tmp)
    dens = density(tmp)
    lines(dens$x, dens$y * ySize / max(dens$y), col="red",lwd=2)
    

    return(file)
  },
  help = paste(
    "The Central Limit Theorem.",
    "The graphic illustrates m different saples of size n",
    "illustrated by open circles at the same level.",
    "Each sample is summarized by a statistic marked with a triangle.",
    "These statistics are shown on the x axis using rug() and summarized",
    "with a density plot (not to scale) in red."
    )
  )

## start with an assignment
assign(".binomialDemo.results",c(),envir=.GlobalEnv)
binomialDemo = list(
  widgets = list(
    "Size of sample, n" = gslider(from=5,to=50,by=5,value=10),
    "Success probablity, p" = gslider(from=.05,to=.95,by=.05,value=0.5),
    "Number at a time" = gradio(c(1,10,25)),
    "Sample one" = gbutton("click"),
    "Clear results" = gcheckbox("")
    ),
  f = function(file, valLst) {
    png(file, width=480, height=480)
    on.exit(dev.off())

    n = valLst[[1]]
    p = valLst[[2]]
    m = valLst[[3]]
    clear = valLst[[5]]

    if(!exists(".binomialDemo.results"))
      assign(".binomialDemo.results",c(),envir=.GlobalEnv)
    if(clear)
      .binomialDemo.results <<- c()

    ## show sample
    
    par(fig=c(0,1,.8,1))
    par(mai=c(0,0,0,0))

    x = rbinom(n, size=1, prob=p) 
    plot.new()
    plot.window(xlim=c(1,n),ylim=c(0,1))
    
    metsCols = c("orange","blue")
    points(1:n,rep(.5,n),pch=16,cex=2,col=metsCols[1 + x])

    ## do I need to add more?
    .binomialDemo.results <<- c(.binomialDemo.results,sum(x))
    if(m > 1)
      .binomialDemo.results <<- c(.binomialDemo.results, rbinom(m-1, n , p))

    ## show results
    par(fig=c(0,1, 0 , .8), new=TRUE)
    par(mar=c(3,2,2,1))
    ## could spice ths up
    if(length(.binomialDemo.results) > 1 ) {
      ## draw a special histogram of the results
      y = .binomialDemo.results
      tbl = table(y)
      plot.new();
      plot.window(xlim=range(y) + c(-1/2,1/2), ylim = c(0,max(tbl)))
      axis(1); axis(2)
      
      cols = c(gray(.9),"blue")[1+as.numeric(names(tbl) == sum(x))]

      names(cols) = names(tbl)
      ## for each val in tbl
      sapply(names(tbl), function(i) {
        x = as.numeric(i)
        polygon(c(x-1/2,x-1/2,x+1/2,x+1/2),c(0,tbl[i],tbl[i],0),col=cols[i])
      })
    }

    return(file)
  },
  help = paste(
    "The binomial distribution. The top figure shows n independent trials ",
    "with success probability p. A success is colored blue.",
    "The number of successes follows a binomial distribution.",
    "The sequence of the number of successess is plotted with a histogram.",
    "To clear out the results, click 'Clear results' twice.",
    collapse="\n")
 )


##################################################
## power

## http://www.amstat.org/publications/jse/v11n3/anderson-cook.html
powerDemo = list(
  widgets = list(
    "Alternative" = gradio(c("less","greater","two.sided")),
    "mu2 - mu1" = gslider(from=-5,to=5, by=.1, value=0),
    "n"  = gslider(from=1, to=25, by=1, value=1),
    alpha = gradio(c(.01, .05, .10), selected=2)
    ),
  f = function(file, valLst) {
    png(file, width=480, height=480)
    on.exit(dev.off())

    HA = valLst[[1]]
    mu2 = valLst[[2]]
    n = valLst[[3]]
    alpha = valLst[[4]]

    x = seq(-5,5, length=1000)
    y1 = dnorm(x, 0, 1/sqrt(n))
    y2 = dnorm(x, mu2, 1/sqrt(n))

    par(mai=c(0,0,0,0))
    plot.new()
    plot.window(xlim=c(-5,5), ylim = c(0, max(y1) + max(y2)))
    axis(1)

    plotPoly = function(x, y, z, toLeft = TRUE, col="blue") {
      i = min(which(x > z))
      n = length(x)
      if(toLeft) {
        polygon(c(x[1],x[1:i],x[i]),c(min(y),y[1:i],min(y)), col=col)
        polygon(c(x[i+1],x[(i+1):n],x[n]),c(min(y),y[(i+1):n],min(y)))
      } else {
        polygon(c(x[1],x[1:i],x[i]),c(min(y),y[1:i],min(y)))
        polygon(c(x[i+1],x[(i+1):n],x[n]),c(min(y),y[(i+1):n],min(y)), col=col)
      }
    }

    Beta = 0
    Beta = switch(HA,
           "less" = {
             z = qnorm(alpha,0,1/sqrt(n))
             abline(v=z)
             plotPoly(x,y1,z, toLeft=TRUE)
             plotPoly(x,y2 + max(y1),z, toLeft=FALSE, col="red")
             ## beta =
             1 - pnorm(z, mu2, 1/sqrt(n))
           },
           "greater" = {
             z = qnorm(1-alpha,0,1/sqrt(n))
             abline(v=z)
             plotPoly(x,y1,z, toLeft=FALSE)
             plotPoly(x,y2 + max(y1),z, toLeft=TRUE, col="red")
             ## return beta
             pnorm(z, mu2, 1/sqrt(n))
           },
           "two.sided" = {
             z = qnorm(1-alpha/2,0,1/sqrt(n))
             abline(v=z)
             abline(v=-z)
             plotPoly(x,y1,-z, toLeft=TRUE)
             plotPoly(x,y1, z, toLeft=FALSE)
             plotPoly(x,y2 + max(y1),z, toLeft=TRUE, col="red")
             plotPoly(x,y2 + max(y1),-z, toLeft=TRUE, col="white")
             ## return beta
              pnorm(z,mu2,1/sqrt(n)) - pnorm(-z,mu2,1/sqrt(n))
           })
    Beta = floor(Beta*100)/100
    text(4,0,label="Null", pos=3)
    text(4,max(y1),label="Alternative", pos=3)
    text(4,max(y1) + 1/2*max(y2), label=paste("Power=",1-Beta))
    return(file)
  },
  help = paste(
    "Power demo. The power of a statistical test indicates the probability of a p-value larger than alpha when the alternative hypothesis is correct.  The power for the z-test depends on the mean postulated for the altervative hypothesis. In this case, the difference mu2 - mu1 is used. The graphic shows in blue the area associated to alpha. and in red the probabliity the NULL is accepted  The power is this latter quantity subtracted from 1.",
    collapse = "\n")
  )

  
  win = pmgWC$new("P M G teaching demos", width=450,height=350)
  group = ggroup(horizontal = FALSE, container=win, expand=TRUE)
  mb = list()
  mb$Demo$"Histogram bin selection"$handler =
    function(...) {
      add(nb,pmgDemo(histogramDemo),label="Histogram")
      svalue(sb) <- ""
    }
  mb$Demo$"histogram and density"$handler = 
    function(...) {
      add(nb, histogramAndDensity(NULL), label = "View histogram and density")
      svalue(sb) <- ""
    }
  mb$Demo$"Binomial distribution"$handler =
    function(...) {
      add(nb,pmgDemo(binomialDemo), label="Binomial")
      svalue(sb) <- ""
    }
  mb$Demo$"construction of normal"$handler = 
    function(...) {
      add(nb, constructionOfNormal(NULL), label = "See normal from sum")
      svalue(sb) <-  ""
    }
  mb$Demo$"Central Limit Theorem"$handler =
    function(...) {
      add(nb,pmgDemo(CLTDemo), label="CLT")
      svalue(sb) <-  ""
    }
  mb$Demo$"probability calculator"$handler = 
    function(...) {
      add(nb, probabilityCalculator(NULL), label = "probability calculator")
      svalue(sb) <- ""
    }
  mb$Demo$"Confidence Intervals"$handler =
    function(...) {
      add(nb, pmgDemo(confIntervalDemo), label = "Confidence intervals")
      svalue(sb) <- ""
    }
  mb$Demo$"Power of test"$handler =
    function(...) {
      add(nb, pmgDemo(powerDemo), label = "Power of a test")
      svalue(sb) <-  ""
    }


  add(group, gmenu(mb))
  nb = gnotebook(closebuttons=TRUE)
  add(group, nb, expand=TRUE)

sb <- gstatusbar(gettext("Select a demo from the menubar above"), cont=group)
}
                
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.tseries.R"
## this is autogenerated. Could fix up
get.hist.quote.LIST <- list(
	title = "get.hist.quote",
	help = "get.hist.quote",
                            type = "text",
                            variableType = "",
                            assignto = TRUE,
                            action = list(
                              beginning = "get.hist.quote(", 
                              ending = ")"),
                            arguments = list(
                              Arguments = list(
                                "instrument"=list(
                                  type= "gedit",
                                  text="'^gdax'"),
                                "start"=list(
                                  type= "gcalendar",
                                  text=""),
                                "end"=list(
                                  type= "gcalendar",
                                  text=""),
                                "quote"=list(
                                  type= "gdroplist",
                                  items=c("'Open'","'High'","'Low'","'Close'","")
                                  ),
                                "provider"=list(
                                  type= "gedit",
                                  text="'yahoo'"),
                                "method"=list(
                                  type= "gedit",
                                  text="'auto'"),
                                "origin"=list(
                                  type= "gcalendar",
                                  text="'1899-12-30'"),
                                "compression"=list(
                                  type= "gedit",
                                  text="'d'")
                                )))
plot.LIST <- list(
                  title = "plot",
                  help = "plot",
                  type = "text",
                  variableType = "bivariate",
                  assignto = TRUE,
                  action = list(
                    beginning = "plot(", 
                    ending = ")"),
                  arguments = list(
                    Arguments = list(
                      "..."=list(
                        type= "gedit",
                        text="")
                      )))

plotOHLC.LIST <- list(
                      title = "plotOHLC",
                      help = "plotOHLC",
                      type = "text",
                      variableType = "univariate",
                      assignto = TRUE,
                      action = list(
                        beginning = "plotOHLC(", 
                        ending = ")"),
                      arguments = list(
                        Arguments = list(
                          "xlim"=list(
                            type= "gedit",
                            text="NULL"),
                          "ylim"=list(
                            type= "gedit",
                            text="NULL"),
                          "xlab"=list(
                            type= "gedit",
                            text="'Time'"),
                          "ylab"=list(
                            type= "gedit",
                            text=""),
                          "col"=list(
                            type= "gedit",
                            text=""),
                          "bg"=list(
                            type= "gedit",
                            text=""),
                          "axes"=list(
                            type= "gradio",
                            index = FALSE,
                            items=c("TRUE","FALSE")),
                          "frame.plot"=list(
                            type= "gedit",
                            text=""),
                          "ann"=list(
                            type= "gedit",
                            text=""),
                          "main"=list(
                            type= "gedit",
                            text="NULL"),
                          "date"=list(
                            type= "gradio",
                            index = FALSE,
                            items=c("'calendar'","'julian'","")),
                          "format"=list(
                            type= "gedit",
                            text="'%Y-%m-%d'"),
                          "origin"=list(
                            type= "gedit",
                            text="'1899-12-30'"),
                          "..."=list(
                            type= "gedit",
                            text="")
                          )))
seqplot.ts.LIST <- list(
                        title = "seqplot.ts",
                        help = "seqplot.ts",
                        type = "text",
                        variableType = "bivariate",
                        assignto = TRUE,
                        action = list(
                          beginning = "seqplot.ts(", 
                          ending = ")"),
                        arguments = list(
                          Arguments = list(
                            "colx"=list(
                              type= "gedit",
                              text="'black'"),
                            "coly"=list(
                              type= "gedit",
                              text="'red'"),
                            "typex"=list(
                              type= "gedit",
                              text="'l'"),
                            "typey"=list(
                              type= "gedit",
                              text="'l'"),
                            "pchx"=list(
                              type= "gedit",
                              text="1"),
                            "pchy"=list(
                              type= "gedit",
                              text="1"),
                            "ltyx"=list(
                              type= "gedit",
                              text="'solid'"),
                            "ltyy"=list(
                              type= "gedit",
                              text="'solid'"),
                            "oma"=list(
                              type= "gdroplist",
                              items=c("'6'","'0'","'5'","'0'","")),
                            "ann"=list(
                              type= "gedit",
                              text=""),
                            "xlab"=list(
                              type= "gedit",
                              text="'Time'"),
                            "ylab"=list(
                              type= "gedit",
                              text=""),
                            "main"=list(
                              type= "gedit",
                              text="NULL")
                            )))
ar.LIST <- list(
                title = "ar",
                help = "ar",
                type = "text",
                variableType = "univariate",
                assignto = TRUE,
                action = list(
                  beginning = "ar(", 
                  ending = ")"),
                arguments = list(
                  Arguments = list(
                    "aic"=list(
                      type= "gradio",
                      index = FALSE,
                      items=c("TRUE","FALSE")),
                    "order.max"=list(
                      type= "gedit",
                      text="NULL"),
                    "method"=list(
                      type= "gdroplist",
                      items=c("'yule-walker'","'burg'","'ols'","'mle'","'yw'","")),
                    "na.action"=list(
                      type= "gedit",
                      text=""),
                    "series"=list(
                      type= "gedit",
                      text=""),
                    "..."=list(
                      type= "gedit",
                      text="")
                    )))
arma.LIST <- list(
                  title = "arma",
                  help = "arma",
                  type = "text",
                  variableType = "univariate",
                  assignto = TRUE,
                  action = list(
                    beginning = "arma(", 
                    ending = ")"),
                  arguments = list(
                    Arguments = list(
                      "order"=list(
                        type= "gradio",
                        index = FALSE,
                        items=c("'1'","'1'","")),
                      "lag"=list(
                        type= "gedit",
                        text="NULL"),
                      "coef"=list(
                        type= "gedit",
                        text="NULL"),
                      "include.intercept"=list(
                        type= "gradio",
                        index = FALSE,
                        items=c("TRUE","FALSE")),
                      "series"=list(
                        type= "gedit",
                        text="NULL"),
                      "qr.tol"=list(
                        type= "gedit",
                        text="1e-07"),
                      "..."=list(
                        type= "gedit",
                        text="")
                      )))
arima0.LIST <- list(
                    title = "arima0",
                    help = "arima0",
                    type = "text",
                    variableType = "univariate",
                    assignto = TRUE,
                    action = list(
                      beginning = "arima0(", 
                      ending = ")"),
                    arguments = list(
                      Arguments = list(
			"order"=list(
                          type= "gdroplist",
                          items=c("'0'","'0'","'0'","")),
			"seasonal"=list(
                          type= "gedit",
                          text=""),
			"xreg"=list(
                          type= "gedit",
                          text="NULL"),
			"include.mean"=list(
                          type= "gradio",
                          index=FALSE,
                          items=c("TRUE","FALSE")),
			"delta"=list(
                          type= "gedit",
                          text="0.01"),
			"transform.pars"=list(
                          type= "gradio",
                          index=FALSE,
                          items=c("TRUE","FALSE")),
			"fixed"=list(
                          type= "gedit",
                          text="NULL"),
			"init"=list(
                          type= "gedit",
                          text="NULL"),
			"method"=list(
                          type= "gradio",
                          index=FALSE,
                          items=c("'ML'","'CSS'","")),
			"n.cond"=list(
                          type= "gedit",
                          text=""),
			"optim.control"=list(
                          type= "gedit",
                          text="")
                        )))
garch.LIST <- list(
                   title = "garch",
                   help = "garch",
                   type = "text",
                   variableType = "univariate",
                   assignto = TRUE,
                   action = list(
                     beginning = "garch(", 
                     ending = ")"),
                   arguments = list(
                     Arguments = list(
                       "order"=list(
                         type= "gradio",
                         index=FALSE,
                         items=c("'1'","'1'","")),
                       "coef"=list(
                         type= "gedit",
                         text="NULL"),
                       "itmax"=list(
                         type= "gedit",
                         text="200"),
                       "eps"=list(
                         type= "gedit",
                         text="NULL"),
                       "grad"=list(
                         type= "gradio",
                         index=FALSE,
                         items=c("'analytical'","'numerical'","")),
                       "series"=list(
                         type= "gedit",
                         text="NULL"),
                       "trace"=list(
                         type= "gradio",
                         index=FALSE,
                         items=c("TRUE","FALSE")),
                       "..."=list(
                         type= "gedit",
                         text="")
                       )))
adf.test.LIST <- list(
                      title = "adf.test",
                      help = "adf.test",
                      type = "text",
                      variableType = "univariate",
                      assignto = TRUE,
                      action = list(
                        beginning = "adf.test(", 
                        ending = ")"),
                      arguments = list(
                        Arguments = list(
                          "alternative"=list(
                            type= "gradio",
                            index=FALSE,
                            items=c("'stationary'","'explosive'","")),
                          "k"=list(
                            type= "gedit",
                            text="")
                          )))
jarque.bera.test.LIST <- list(
                              title = "jarque.bera.test",
                              help = "jarque.bera.test",
                              type = "text",
                              variableType = "",
                              assignto = TRUE,
                              action = list(
                                beginning = "jarque.bera.test(", 
                                ending = ")"),
                              arguments = list(
                                Arguments = list(
                                  "x"=list(
                                    type= "gedit",
                                    text="")
                                  )))
kpss.test.LIST <- list(
                       title = "kpss.test",
                       help = "kpss.test",
                       type = "text",
                       variableType = "univariate",
                       assignto = TRUE,
                       action = list(
                         beginning = "kpss.test(", 
                         ending = ")"),
                       arguments = list(
                         Arguments = list(
                           "null"=list(
                             type= "gradio",
                             index=FALSE,
                             items=c("'Level'","'Trend'","")),
                           "lshort"=list(
                             type= "gradio",
                             index=FALSE,
                             items=c("TRUE","FALSE"))
                           )))
runs.test.LIST <- list(
                       title = "runs.test",
                       help = "runs.test",
                       type = "text",
                       variableType = "univariate",
                       assignto = TRUE,
                       action = list(
                         beginning = "runs.test(", 
                         ending = ")"),
                       arguments = list(
                         Arguments = list(
                           "alternative"=list(
                             type= "gdroplist",
                             items=c("'two.sided'","'less'","'greater'",""))
                           )))
white.test.LIST <- list(
                        title = "white.test",
                        help = "white.test",
                        type = "text",
                        variableType = "univariate",
                        assignto = TRUE,
                        action = list(
                          beginning = "white.test(", 
                          ending = ")"),
                        arguments = list(
                          Arguments = list(
                            "..."=list(
                              type= "gedit",
                              text="")
                            )))

automenu.list=list(
  "data"=list(
    "get.hist.quote"='get.hist.quote.LIST'
    ),
  "plot"=list(
    "plot"='plot.LIST',
    "plotOHLC"='plotOHLC.LIST',
    "seqplot.ts"='seqplot.ts.LIST'
    ),
  "fit"=list(
    "ar"='ar.LIST',
    "arma"='arma.LIST',
    "arima0"='arima0.LIST',
    "garch"='garch.LIST'
    ),
  "tests"=list(
    "unitroot"=list(
      "adf.test"='adf.test.LIST'
      ),
    "normality"=list(
      "jarque.bera.test"='jarque.bera.test.LIST'
      ),
    "stationarity"=list(
      "kpss.test"='kpss.test.LIST'
      ),
    "randomness"=list(
      "runs.test"='runs.test.LIST'
      ),
    "nonlinearity"=list(
      "white.test"='white.test.LIST'
      )
    )
)
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/pmg.viewDataSets.R"
getDataSets = function(...) {
  dataSets = data()$results
  dataSets = dataSets[, c(3,1,4)]
  return(dataSets)
}

## uses data() to move data set into environment
pmg.viewDataSets = function(width=550, height=400) {
  
  win = pmgWC$new("Load data set", v=T)
  size(win) <-  c( width, height)
  group = ggroup(horizontal=FALSE, container=win, expand=TRUE)

  

  dataSetHandler = function(h,...) {
    dataSets = svalue(dataSetList, drop=FALSE)
    for(i in 1:nrow(dataSets)) {
      dataset = dataSets[i,1]
      package = dataSets[i,2]
      command = Paste("data(",dataset,",package=\"",package,"\")")
      cat(pmg.prompt,command,"\n")
      svalue(status) <- Paste("attach data set ",dataset)
      do.call("data",list(dataset, package=package))
      svalue(status)
    }
  }

  
  dataSetList = gtable(getDataSets(), multiple=TRUE, filter.column = 2,
    handler =  dataSetHandler)
  add(group, dataSetList, expand=TRUE)

  ## add buttons
  buttonGroup = ggroup(container=group)
  addSpring(buttonGroup)
  gbutton("cancel",container=buttonGroup, handler = function(h,...) dispose(win))

  status = gstatusbar("Double click data set to load",container=group)

  ## return window if desired -- can use destroy then.
  invisible(win)
}
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/qplotGUI.R"
## NOT WORKING!!! -- can't get eval command to work. Gives
## error about scale

qplotGUI = function(container = NULL, ...) {
  do.call("require",list("ggplot2"))
  
  ## globals
  widgets = list()
  extraArgsWidgets = list()
  geomVals1d = data.frame(geoms=c("histogram","density"),stringsAsFactors=FALSE)
  geomVals2d = data.frame(geoms=c("point","smooth","boxplot","quantile","line","path","density2d","jitter"), stringsAsFactors=FALSE)
  
  
  ## handler for getting variable using either data or globalenv
  getValueFromString = function(str) {
    if(str == "") return(NA)
    
    dfName = svalue(widgets[['data']])
    if(dfName != "") {
      ## there is a data frame
      df = get(dfName, envir=.GlobalEnv)
      ret = with(df, try(eval(parse(text=str)), silent=TRUE))
    } else {
      ## get from global environment
      try(eval(parse(text=str), envir=.GlobalEnv), silent=TRUE)
    }
    return(ret)
  }
  

  nb = gnotebook(cont=container, tab.pos = 1, ...)

  ## main group
  qpg = ggroup(horizontal=FALSE, cont=nb, label="qplot")
  parg =ggroup(horizontal=FALSE, cont=nb, label="plot args")

  ## work on qplot group
  tbl = glayout(cont=qpg)
  
  ## x, y
  tbl[1,1, anchor=c(1,0)] <- "x"
  tbl[1,2] <- (widgets[['x']] <- gdroplist(c(),editable=TRUE, cont=tbl))
  
  tbl[1,3, anchor=c(1,0)] <- "y"
  tbl[1,4] <- (widgets[['y']] <- gdroplist(c(),editable=TRUE, cont=tbl))
  
  ## data
  tbl[2,1, anchor=c(1,0)] <- "data"
  tbl[2,2] <- (widgets[['data']] <- gedit("", cont=tbl))
  
  ## weigths
  tbl[2,3, anchor=c(1,0)] <- "weights"
  tbl[2,4] <- (widgets[['weights']] <- gdroplist(c(),editable=TRUE, cont=tbl))
  
  
  tbl[3,1:4] <- gseparator(cont=tbl)
  
  ## geom
  tbl[4,1, anchor=c(1,0)] <- "geom"
  tbl[4:8,2] <- (widgets[['geom']] <- gtable(geomVals1d,multiple=TRUE,cont=tbl))
  size(widgets[['geom']]) <- c(150,125)
  
  ## stat
  tbl[4,3, anchor = c(1,0)] <- "args"
  tbl[4:8, 4] <- (widgets[['args']] <- gnotebook(tab.pos=3,cont=tbl))
  
  tbl[9,1:4] <- gseparator(cont=tbl)
  
  ## facet
  tbl[10,1, anchor = c(1,0)] <- "facets"
  tbl[10,2:4] <- (fgp <- ggroup(horizontal=TRUE, cont=tbl))
  widgets[['fresp']] <- gdroplist(".",editable=TRUE, cont=fgp)
  glabel("~", cont=fgp)
  widgets[['fpred']] <- gdroplist(".",editable=TRUE, cont=fgp)
  gbutton("edit",cont=fgp, handler = function(h,...) {
    if(svalue(widgets[['data']]) != "") {
      gWidgets:::editFormulaDialog(data = widgets[['data']],
                                   responsewidget = widgets[['fresp']],
                                   predictorwidget = widgets[['fpred']])
    } else {
      cat("Data is empty, facet needs to have  a data frame set\n")
    }
  })
  
  
  ## add
#  tbl[11,1:4] <- gseparator(cont=tbl)
#  tbl[15,1,anchor=c(1,0)] <- "add"
#  tbl[15,2] <- (widgets[['add']] <- gedit("",cont=tbl))
  
  ## for RGtk2
  visible(tbl) <- TRUE
  
  
  ## plot args tab
  tbl = glayout(cont=parg)
  
  tbl[1,1,anchor=c(1,0)] <- "xlim"
  tbl[1,2] <- (widgets[['xlim']] <- gedit("", cont=tbl))
  
  tbl[1,3,anchor=c(1,0)] <- "ylim"
  tbl[1,4] <- (widgets[['ylim']] <- gedit("", cont=tbl))
  
  tbl[2,1,anchor=c(1,0)] <- "log"
  tbl[2,2] <- (widgets[['log']] <- gdroplist(c("","x","y","xy"),cont=tbl))
  
  tbl[3,1:4] <- gseparator(cont=tbl)
  
  tbl[4,1,anchor=c(1,0)] <- "main"
  tbl[4,2:4] <- (widgets[['main']] <- gedit("",cont=tbl))
  
  tbl[5,1,anchor=c(1,0)] <- "xlab"
  tbl[5,2] <- (widgets[['xlab']] <- gedit("", cont=tbl))
  
  tbl[5,3,anchor=c(1,0)] <- "ylab"
  tbl[5,4] <- (widgets[['ylab']] <- gedit("", cont=tbl))
  
  tbl[6,1:4] <- gseparator(cont=tbl)
  
  tbl[7,1, anchor=c(1,0)] <- "margins"
  tbl[7,2] <- (widgets[['margins']] <-
               gdroplist(c("", TRUE, "'grand_row'","'grand_col'"),
                         editable=TRUE, cont=tbl))
  
  tbl[8,1:4] <- gseparator(cont=tbl)
  ## ## colour size shape linetype
  ## tbl[9,1,anchor=c(1,0)] <- "colour"
  ## tbl[9,2] <- (widgets[['colour']] <- gdroplist(c(), editable=TRUE, cont=tbl))
  
  ## tbl[9,3,anchor=c(1,0)] <- "size"
  ## tbl[9,4] <- (widgets[['size']] <- gdroplist(c(), editable=TRUE, cont=tbl))
  
  ## tbl[10,1,anchor=c(1,0)] <- "shape"
  ## tbl[10,2] <- (widgets[['shape']] <- gdroplist(c(), editable=TRUE, cont=tbl))
  
  ## tbl[10,3,anchor=c(1,0)] <- "linetype"
  ## tbl[10,4] <- (widgets[['linetype']] <- gdroplist(c(), editable=TRUE, cont=tbl))
  
  ## RGtk2
  visible(tbl) <- TRUE

  ## set tab
  svalue(nb) <- 1

  ##
############ end layout ####################
  
  ## useful functions

  ## update variables based on value of data
  updateVarNames = function(dataVal) {
    theNames = c()
    if(length(dataVal) == 0 || dataVal == "") {
      ## .globalEnv -- list all of them
      is.variable = function(i) is.numeric(i) || is.factor(i) 
      tmp = sapply(ls(envir=.GlobalEnv),function(i) {
        is.variable(get(i))})
      theNames = names(tmp)[tmp]
    } else {
      ## try to see if data has names
      theData = try(get(dataVal,envir=.GlobalEnv), silent=TRUE)
      if(!inherits(theData,"try-error")) {
        tmp = try(names(theData), silent=TRUE)
        if(!inherits(tmp,"try-error")) theNames = names(theData)
      }
    }

    ## add to x, y, fresp, fpred, colour, size, linetype
    if(length(theNames) > 0) 
      sapply(c("x","y","weights"), ##,"colour","size", "shape","linetype"),
             function(i) 
             widgets[[i]][] <- c("",theNames))
    sapply(c("fresp","fpred"), function(i) # . is default
           widgets[[i]][] <- c(".",theNames))
    
    invisible()
  }
  
  
  updateGeoms = function(...) {
    yVal = svalue(widgets[['y']])
    cat("DEBUG: what is yval:",yVal,"\n")
    if(yVal == "")
      widgets[['geom']][,] <- geomVals1d
    else
      widgets[['geom']][,] <- geomVals2d
  }
  
  
  ## update the args to match values selected by geom
  extraArgConfig = list(
    histogram = c("binwidth"),
    density = c(),
    point = c(),
    smooth = c("method"),
    boxplot = c(),
    quantile = c("formula", "quantile"),
    line = c(),
    path = c(),
    density2d = c()
    )
  
  
  
  updateExtraArgs = function(...) {
    
    selGeoms = svalue(widgets[['geom']])
    anb = widgets[['args']]
    if(length(selGeoms) == 0) {
      if( (n <- length(anb)) > 0)
        for(i in n:1) {svalue(anb) <- i; dispose(anb)}
    }
    
    doThese = unique(unlist(extraArgConfig[selGeoms]))
    ## delete those not there
    currentOnes = names(anb)
    if(length(doThese) == 0) {
      ## delete notebook pages, adn all of extraArgsWidgets
      extraArgsWidgets <<- list()
      n = length(anb)
      if(n > 0) {
        for(i in n:1) {
          svalue(anb) <- i; dispose(anb)
        }
      }
    } else {
      deleteThese = setdiff(currentOnes, doThese)
      addThese = setdiff(doThese, currentOnes)
      
      ## delete
      if(length(deleteThese) >0) {
        for(i in rev(which(deleteThese == currentOnes))) {
          svalue(anb) <- i; dispose(anb)
        }
        for(i in deleteThese) {
          extraArgsWidgets[[i]] <<- NULL
        }
      }
      
      
      ## add new ones
      for(i in addThese) {
        eg = ggroup(horizontal=FALSE, cont=anb, label=i)
        ## different based on thing.
        if(i == "method") {
          ## just do lm
          glabel("Using lm method", cont=eg)
          tmp =  ggroup(cont=eg)
          glabel("formula", cont=tmp)
          extraArgsWidgets[['formula']] <<-
            gdroplist(c("",
                        "y ~ ns(x,1)",
                        "y ~ ns(x,2)",
                        "y ~ ns(x,3)"),
                      coerce.with = function(str) {
                        if(str == "")
                          return(str)
                        else
                          return(formula(str))
                      },
                      handler = updateGraphic,
                      editable=TRUE, cont=tmp)
        } else if(i ==  "quantile") {
          tmp = ggroup(cont=eg)
          glabel("quantile", cont=tmp)
          extraArgsWidgets[["quantile"]] <<-
            gdroplist(
                      c("",
                        "seq(.05,.95,by=.05)",
                        "seq(.10,.90,by=.10)",
                        "seq(.25,.75,by=.25)"),
                      coerce.with = function(str) {
                        ifelse(str=="","",try(eval(parse(text=str)),silent=TRUE))
                      },
                      handler = updateGraphic,
                      editable=TRUE, cont=tmp)
        } else if(i == "binwidth") {
          tmp = ggroup(cont=eg)
          glabel("binwidth", cont=tmp)
          extraArgsWidgets[["binwidth"]] <<- gedit("", cont=tmp,
                                                   coerce.with=as.numeric,
                                                   handler=updateGraphic)
        } else if(i == "formula") {
          tmp = ggroup(cont=eg)
          glabel("formula", cont=tmp)
          extraArgsWidgets[["quantile"]] <<-
            gdroplist(
                      c("",
                        "y ~ ns(x,1)",
                        "y ~ ns(x,2)",
                        "y ~ ns(x,3)"),
                      coerce.with = function(str) {
                        ifelse(str == "", "", formula(str))
                      },
                      handler = updateGraphic,
                      editable=TRUE, cont=tmp)
          
        }
      }
    }
  }
  
  ## get values for args notebook. Return a list with values
  getExtraArgValues = function() {
    tmp = list()
    
    if(length(extraArgsWidgets) == 0) return(tmp)
    
    for(i in names(extraArgsWidgets)) {
      val = svalue(extraArgsWidgets[[i]])

      if(is.na(val) ||
         is.null(val) ||
         (is.character(val) && val[1] == "")) {
        ## what?
      } else {
        tmp[[i]] <- val
      }
    }
    
    ## fix up method
    if("smooth" %in% svalue(widgets[['geom']]) &&
       !is.null(tmp$formula) &&
       tmp$formula != "") {
      tmp$method <- "lm"
    }
    
    return(tmp)
  }
  
  ## Key to this is handling the different geoms and the new infor we add to them
  ## smooth loess(span (in [0,1]), lm( y ~ poly(x,1) default)
  ## quantile (formula y ~ poly(x,1)


  ## Grab values and make a plot
  updateGraphic = function(...) {
    ## first make sure this is current
    updateExtraArgs()


    
    tmp = lapply(widgets, svalue)

    ## updateVarNames
    updateVarNames(tmp$data)
    
    ## check if we can
    if(length(tmp$geom) == 0 || tmp$x == "") {
      cat("need to specify a variable or geom\n")
      return()
    }


    l = list()                      # store args here
    if(tmp$data != "") {
      ## there is a data frame
      df = get(tmp$data, envir=.GlobalEnv)
      l$data <- df
      l$x = with(df, try(eval(parse(text=tmp$x)), silent=TRUE))
      ## same for y
      if(tmp$y != "")
        l$y = with(df, try(eval(parse(text=tmp$y)),silent=TRUE))
    } else {
      ## get names from global environment
      l$x <- try(eval(parse(text=tmp$x), envir=.GlobalEnv), silent=TRUE)
      if(tmp$y != "")
        l$y <- try(eval(parse(text=tmp$x), envir=.GlobalEnv), silent=TRUE)
    }



    ## fix x, y labels
    l$xlab = ifelse(tmp$xlab == "", tmp$x, tmp$xlab)
    l$ylab = ifelse(tmp$ylab == "", tmp$y, tmp$ylab)
    
    ## done with x, y, data, xlab, ylab
    ## now handle facets
    if(tmp$fresp != "" && tmp$fpred != "")
      l$facets = formula(paste(tmp$fresp, "~", tmp$fpred, sep="  "))
    
    ## deal with extra arguments to geoms
    if(length(tmp$args) > 0) {
      ## we have extra arguments
      
      res = getExtraArgValues()
      for(i in names(res))
        l[[i]] <- res[[i]]
    }
    
    
    ## now add in the rest of the arguments
    trimIt = function(i) is.null(i) || (length(i) == 1 && i == "")
    
    tmp$x <- tmp$y <- tmp$data <- tmp$xlab <- tmp$ylab <- NULL
    tmp$fresp <- tmp$fpred <- NULL
    tmp$args <- NULL
    
    ## How to deal with these and do.call? They label doesn't work correctly
    
    ##   ## These numeric guys we do separately and in the calling environment
    ##   for(i in c("colour","size","shape","linetype")) {
    ##     if(tmp[[i]] != "") {
    ##       l[[i]] <- getValueFromString(tmp[[i]])
    ##       tmp[[i]] <- NULL
    ##     }
    ##   }
    
    ## the rest
    tmp = tmp[!sapply(tmp,trimIt)]
    for(i in names(tmp)) {
      l[[i]] <- tmp[[i]]
    }
    
    ## make graphic
    ret = try(print(do.call("qplot",l)), silent=TRUE)
    if(inherits(ret,"try-error")) {
      cat("Error with qplot:",ret,"\n")
      return()
    }
  }
   
  updateGraphic.paste = function(...) {
    tmp = lapply(widgets, svalue)
 
    ## check if we can
    if(length(tmp$geom) == 0 || tmp$x == "") {
      cat("need to specify a variable or geom\n")
      return()
    }
 
    ## try to paste together all the arguments
    ## then call within with
 
    cmd = paste("print(qplot(x=",tmp$x, sep="")
    tmp$x <- NULL
 
    pasteIfNotNull = function(lab,val) {
      if(!is.null(val) && val != "")
        cmd <<- paste(cmd,", ",lab,"=",val, sep="")
    }
 
    ## handle y, data, geoms, facets separately
    pasteIfNotNull("y", tmp$y)
    tmp$y <- NULL
 
    if(tmp$data != "") {
      df = get(tmp$data, envir=.GlobalEnv)
    } else {
      df = .GlobalEnv
    }
    tmp$data = NULL
 
    ## geoms
    pasteIfNotNull("geom",
                   paste("c('",paste(tmp$geom, collapse="', '"),"')", sep="")
                   )
    tmp$geom <- NULL
    tmp$args <- NULL
 
    if(tmp$fresp != "" && tmp$fpred != "") 
      pasteIfNotNull("facets",paste(tmp$fresp, "~", tmp$fpred, sep="  "))
    tmp$fresp <- tmp$fpred <- NULL
 
    ## add the rest
    for(i in names(tmp)) {
      pasteIfNotNull(i, tmp[[i]])
    }
 
    cmd = paste(cmd, "))", sep="")
 
    print(cmd)
    with(df, eval(parse(text=cmd)))
 
  }


  ## add handlers
  
  
  
  ## update graphic -- error checking inside updateGraphic
  sapply(names(widgets), function(i) {
    ## treat "y", "data" separately for tcltk
    if(i != "y" || i != "data")
      addHandlerChanged(widgets[[i]], handler = function(h,...) {
        updateGraphic()
      })
  })
  
  
  addHandlerClicked(widgets[['geom']], handler = function(h,...) {
    updateGraphic()
  })
  
  
  ## y --> change from 1d to 2d geoms
  addHandlerChanged(widgets[['y']], handler = function(h,...) {
    updateGeoms()
  })
  
  ## data --> update variable names
  addHandlerChanged(widgets[['data']], handler=function(h,...) {
    updateVarNames(svalue(h$obj))
    updateGraphic()
  })
  addDropTarget(widgets[['data']], handler = function(h,...) {
    updateVarNames(h$dropdata)
    updateGraphic()
  })


  ## all done, return top container
  return(nb)
  
}



## ## partial GUI for qplot function
## require(ggplot2)
## options("guiToolkit"="RGtk2")
## require(gWidgets)

## ##Usage:
## ##
## ## qplot(
## ## x, y = NULL, z=NULL, ..., data,
## ## facets = . ~ .,
## ## margins=FALSE,
## ## geom = "point",
## ## stat=list(NULL),
## ## position=list(NULL),

## ## -- par tab 
## ##xlim = c(NA, NA), ylim = c(NA, NA), log = "",
## ## main = NULL, xlab = deparse(substitute(x)), ylab = deparse(substitute(y)),

## ##add=NULL)






## ## set up top level
## win = gwindow("qplot GUI", width=700, height=400)
## g = ggroup(horizontal=FALSE, cont=win, expand=TRUE)  # main group


## tb = list()
## tb$Quit$handler = function(h,...) dispose(win)
## tb$Quit$icon = "quit"
## tb = gtoolbar(tb, cont=g)


## pg = gpanedgroup(cont=g, exand=TRUE)
## vb = gvarbrowser(cont=pg)                    # left varbrowser

## nb = qplotGUI(cont = pg)
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/quantileWidget.R"
## This is a practice for making better widgets for beginning students
## It seems like a good student widget should have:
## * a graphic
## * dynamic response to change of variables
## * visible output, students don't like quiet GUIs

## in misc.R
## is.gdataframecolumn = function(obj) {
##   if(class(obj)[1] == "GtkTreeViewColumn")
##     return(TRUE)
##   else
##     return(FALSE)
## }

## make a graphic save to png file, return file name
dp = function(x,probs=NULL,
  cols = gray(seq(.25, .75, length=length(probs))),
  f = tempfile()
  ) {
  width = 200; height= 200
  png(f, pointsize=4, width=width, height=height)
  par(mai=c(0,0,0,0))
  
  if(missing(x)) {
    ## make an empty graphic
    plot.new(); plot.window(xlim=c(0,1),ylim=c(0,1))
    text(.5,.5,"Add variable")
  } else {
    ## make a pretty graphic

    d = density(x, na.rm=TRUE)
    

    plot(d, xlab="",ylab="",main="")
    rug(x)

    cumSums = cumsum(d$y[-1]*diff(d$x))
    cumSums[1] = 0; cumSums[512] = 1
    if(!is.null(probs)) {
      n = length(probs)
      probs = sort(probs)
      for(i in n:1) {
        j = max(which(cumSums <= probs[i]))
        polygon(c(d$x[1:j],rev(d$x[1:j])),c(d$y[1:j],rep(0,j)),col=cols[i])
      }
    } 
  }

  ## return filename of graphic
  dev.off()
  return(f)
}


## Write a widget to display quantiles
## then abstract to make general widget

quantileWidget = function(container=NULL) {

  ## Define layout and primary widgets:
  ## f
  ## plotGraphic
  ## xVar
  ## probsVar
  ## outputArea
  group = ggroup(horizontal=FALSE, container=container)
  obj=group                                # will return this, can use to add things to with
                                        # tag()
  f = dp()                              # default value
  tag(obj,"graphicFilename") <- f
  plotGraphic = gimage(f, container=group)
  gseparator(horizontal=TRUE, container=group)

  tbl = glayout()
  tbl[1,1] = glabel("x:")
  xVar = glabel("Add variable here", editable=TRUE)
  font(xVar)<-list(style="bold")

  tag(obj,"xVarData") <- NULL
  tbl[1,2] = xVar

  tbl[2,1] <- glabel("probs:")
  probsVar = gdroplist(c("c()","c(.25,.5,.75)","seq(.2,.8,by=.2)",
    "seq(.1,.9,by=.1)","seq(.05,.95,by=.05)"))
  tag(obj,"probsVarData") <- NULL
  tbl[2,2] = probsVar

  add(group,tbl)
  visible(tbl)<-TRUE

  outputArea = gtext("")
  add(group, outputArea, expand=TRUE)

  ## Now add actions
  addhandlerchanged(xVar,
                    handler = function(h,...) {
                      ids = tag(obj,"dropHandlers")
                      if(length(ids) > 0) {
                        removehandler(obj,ids)
                        tag(obj,"dropHandlers") <- list()
                      }
                      tag(obj, "xVarData") <- svalue(h$obj)
                      ## put popup on 1
                      ## svalue(tag(obj,"actionPopup"),index=TRUE) <- 1
                      
                      update()
                    })
  adddroptarget(xVar,
                handler=function(h, ...) {
                  tag(obj,"xVarData") <- h$dropdata
                  svalue(xVar) <- id(h$dropdata)
                  ## put popup on 1
                  ## svalue("actionPopup",index=TRUE) <- 1
                  
                  update()
                  
                  ## now bind to be dynamic *if* a treeviewcolumn
                  if(is.gdataframecolumn(h$dropdata)) {
                    view.col = h$dropdata
                    id = addhandlerchanged(view.col,
                      signal = "edited",
                      handler=function(h,...) update()
                      )
                    dropHandlers = tag(obj,"dropHandlers")
                    dropHandlers[[length(dropHandlers)+1]] = list(
                                  view.col = view.col,
                                  id = id
                                  )
                    tag(obj,"dropHandlers") <- dropHandlers
                  }
                })

  ## for probs we have to parse text to make sure it is valid R code
  addhandlerchanged(probsVar, function(h,...) {
    errMsg = "The value of Probs: should evaluate to a vector of probabilities, e.g. c(.25,.5,.75)"

    val = svalue(probsVar)              # command like "c(1,2,3)"
    vals = try(eval(parse(text=val), envir=.GlobalEnv), silent=TRUE)
    if(inherits(vals, "try-error")) {
      cat(errMsg); cat("\n")
      return()
    } else {
      if(any(vals >1) || any(vals < 0)) 
        cat("Probs: are probabilities between 0 and 1\n")
      vals = vals[vals <=1 && vals >= 0] # these are probabilities
      vals = sort(vals)                 # sort if funny
      if(length(vals) >= 1) {
        tag(obj,"probsVarData") <- vals
        update()
      }
    }
  })

  update = function() {
    ## update the graph, update the function
    x = svalue(tag(obj,"xVarData"))
    if(!is.numeric(x)) {
      cat("the x variable is not numeric\n")
      return()
    }
    
    probs = tag(obj,"probsVarData")
    f = tag(obj,"graphicFilename")
    f = dp(x, probs, f=f)
    svalue(plotGraphic) <- f            # update graphic

    ## get numeric summaries, trim down digits
    oldDigits = getOption("digits")
    options("digits"=2)
    if(length(probs) >= 1)
      outValue = capture.output(quantile(x, probs=probs, na.rm=TRUE))
    else
      outValue = "specify a value for 'probs' (a vector of probabilities)"
    options("digits"=oldDigits)

    dispose(outputArea)
    add(outputArea, "Quantiles:\n",font.attr=c("monospace","blue"))
    add(outputArea, outValue, font.attr=c("monospace"))

    svalue(outputArea) <- c("Quantiles:\n",outValue)
  }

  ## return the widget
  return(obj)
}
                                
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/repeatTrials.R"
## Function and GUI suggested by Daniel Kaple
## Daniel Kaplan 

## make these pmg functions. resample? too generic?
pmgRepeatTrials = function(expr, n = 10) {
  ## return n values
  if(!is.expression(expr))
    expr = as.expression(substitute(expr))
  out = try(sapply(1:n, function(...) eval(expr, envir=.GlobalEnv)),silent=TRUE)
  if(inherits(out,"try-error")) {
    cat(gettext("Error occurred."))
    return(NA)
  }
    
  if(is.matrix(out))
    return(t(out))
  else
    return(out)
}



repeatTrialsGUI = function(container = NULL) {
  
  ## main dialog
  actions = c("","print", "plot","hist","boxplot")
  
  g = gframe("Repeat trials", cont=container)
  tbl <- glayout(cont = g)
  
  tbl[1,1, anchor=c(1,0)] <- "expression"
  tbl[1,2] <- (.expr <- gedit("", cont=tbl))
  tbl[2,1, anchor=c(1,0)] <- "No. of times"
  tbl[2,2] <- (.n <- gedit(10, cont=tbl, coerce.with=as.numeric))
  tbl[3,1:2] <- gseparator(cont=tbl)
  tbl[4,1, anchor=c(1,0)] <- "Quick action"
  tbl[4,2, anchor=c(-1,0)] <- (.actions <- gdroplist(actions, editable=TRUE, cont=tbl))
  tbl[5,1, anchor=c(1,0)] <- "Save as"
  tbl[5,2] <- (.saveAs <- gedit("", cont=tbl))
  tbl[6,1:2] <- gseparator(cont=tbl)

  
  tbl[7,2, anchor=c(-1,0)] <- (bg  <- ggroup(cont=tbl))

  .resample <- gbutton("Repeat trials", cont = bg)
  addSpace(bg, 10)
  .help <- gbutton("help", cont= bg, handler = function(h,...) {
    ghelp("repeatTrials",package="pmg",
          container = pmgWC$new("repeatTrials", width=400, height=250))
  })
  
  visible(tbl) <- TRUE
  
  ## add handler to resample button
  addHandlerClicked(.resample, handler = function(h,...) {
    theExpression = svalue(.expr)
    if(theExpression == "") {
      cat("Need an expression\n")
      return()
    }
    theExpression = try(parse(text = theExpression),silent=TRUE)
    if(inherits(theExpression,"try-error")) {
      cat(gettext("Error in the expression\n"))
      return(FALSE)
    }
    
    n <- svalue(.n)
    if(is.na(n) || (!is.numeric(n) && n < 0)) {
      cat("No. of times is a positive intefer\n")
      return()
    }
    
    res = pmgRepeatTrials(theExpression, n)
    
    if((action <- svalue(.actions)) != "") {
      l = list(res)
      if(action %in% c("plot","hist","boxplot"))
        l = c(l, list(xlab="Simulation",ylab="", main=""))
      try(do.call(action, l), silent=TRUE)
    }
    
    saveAs = svalue(.saveAs)
    if(saveAs != "")
      assign(saveAs, res, envir=.GlobalEnv)
    
  })

  return(g)
}
                    
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/reshape.R"
## gui for reshape package

## startup stuff
## options("guiToolkit"="RGtk2")
## require(gWidgets)
## require(gWidgetsRGtk2)
## require(reshape)

## provides two functions: meltGUI and castGUI.
## How to improve these?

pmg.meltGUI = function(container = pmgWC$new("Melt a data frame")) {
  if(!do.call("require",list("reshape"))) {
    cat("Need to install reshape package\n")
    return()
  }
    

  ## Helper functions
  idVarsDF = function(df) {
    d = data.frame(
      "variable name"=names(df),
      "variable type"=sapply(df, function(i) class(i)[1]),
      stringsAsFactors=FALSE)
    return(d)
  }

  guessIdVars = function(d) {
   ## d has been through idVarsDF
    which(d[,2] %in% c("factor","integer"))
  }

  getMeltedObject = function() {

    theName = svalue(theDF)
    theVals = try(get(theName),silent=TRUE)
    ## verify data frame is good
    if(inherits(theVals,"try-error") ||
       !(is.data.frame(theVals) || is.matrix(theVals))) {
      gmessage(paste(theName,"does not refer to a data frame or matrix",sep=" ",collapse=" "))
      return()
    }

    varNames = svalue(theIDVars)
    theList = list(data=theVals,
      id.var = varNames,
      variable_name = svalue(theVarName),
      preserve.na = svalue(thePreserveNA)
      )

    newMelt = do.call("melt",theList)

    return(newMelt)
  }
 


  ## GUI
  g = ggroup(horizontal=FALSE, cont=container, raise.on.dragmotion = TRUE)
  glabel("Melt a data frame", cont=g)

  layout = glayout(cont=g)

  ## theDF -- for data frame name
  layout[1,1] = glabel("data frame:")
  theDF = gedit()
  layout[1,2] = theDF

  ## theIDVars -- for selecting id variables
  layout[2,1] = glabel("id.var")
  dummyDF = data.frame("variable Name" = "","variable type"="",stringsAsFactors=FALSE)
  theIDVars = gtable(dummyDF, multiple=TRUE)
  
  size(theIDVars) <- c(300,200)
  layout[2,2] = theIDVars

  ## variable Name
  layout[3,1] = glabel("variable name")
  theVarName = gedit("variable")
  layout[3,2] = theVarName

  ## preserve.na
  layout[4,1] = glabel("preserve.na")
  thePreserveNA = gdroplist(c(TRUE,FALSE))
  layout[4,2] = thePreserveNA

  ## update
  theUpdate = gbutton("update")
  layout[5,2] = theUpdate
  
  visible(layout) <- TRUE

  
  ## preview area
  add(g,gseparator(horizontal=TRUE))
  previewGroup = gexpandgroup("Preview",cont=g)
  thePreview  =  glabel("")
  add(previewGroup, thePreview, expand=TRUE) # use delete/add to chnage
  visible(previewGroup) <- TRUE              # open as default
  
  ## saveAs area
  add(g,gseparator(horizontal=TRUE))
  saveAsGroup = ggroup(cont=g)
  saveAsButton = gbutton("Save output as:",cont=saveAsGroup)
  saveAs = gedit("",cont=saveAsGroup)
  enabled(saveAsGroup) <- FALSE
  ## End of layout


  ## data frame
  addhandlerchanged(theDF,handler = function(h,...) {
    theName = svalue(theDF)

    ## trust but verify
    theVals = try(get(theName))
    if(inherits(theVals,"try-error") ||
       !(is.data.frame(theVals) || is.matrix(theVals))) {
      gmessage(paste(theName,"does not refer to a data frame or matrix",sep=" ",collapse=" "))
    } else {

      ## updateIDVars area
      tmp <- idVarsDF(theVals)
      theIDVars[,] <- tmp
      svalue(theIDVars) <- guessIdVars(tmp)
    }
  })

  ## updatebutton
  addhandlerchanged(theUpdate, handler = function(h,...) {
    newMelt = getMeltedObject()

    ## update preview
    delete(previewGroup, thePreview)
    thePreview <<- gtable(head(newMelt, n = 15))
    
    add(previewGroup, thePreview, expand=TRUE)
    enabled(thePreview) <- FALSE
    
    ## make output area visible
    enabled(saveAsGroup) <- TRUE
    
  })

  ## saveAs
  saveHandler = handler = function(h,...) {
    newMelt = getMeltedObject()

    varName = svalue(saveAs)
    ## check
    if(varName == "") {
      gmessage("No variable name specified")
      return()
    }
    if(exists(varName, envir=.GlobalEnv)) {
      val = gconfirm(paste("Overwrite value for",varName,"?",sep=" "))
      if(val == FALSE)
        return()
    }
                         
    assign(varName, newMelt, envir=.GlobalEnv)

    enabled(saveAsGroup) <- FALSE
  }

  ## clicking button, or enter after editing variable will do it.
  addhandlerchanged(saveAsButton, handler=saveHandler)
  addhandlerchanged(saveAs, handler=saveHandler)

  invisible()
}


pmg.castGUI = function(container=pmgWC$new("Cast data")) {

  if(!do.call("require",list("reshape"))) {
    cat("Need to install reshape package\n")
    return()
  }

  
  g = ggroup(horizontal=FALSE, cont=container, raise.on.dragmotion = TRUE)

  theData = gedit("", width=75)

  theVariables = gtable(data.frame(ID.vars="", stringsAsFactors=FALSE))
  adddropsource(theVariables, handler=function(h,...) svalue(theVariables))

  ## formula
  defColFormText = "Drop column variable(s) here"
  defRowFormText = "Drop row variable(s) here"
  colFormula = glabel(defColFormText, editable=TRUE)
  font(colFormula) <- c(style="bold")
  rowFormula = glabel(defRowFormText, editable=TRUE)
  font(rowFormula) <- c(style="bold")  

  aggregateFuns = c("length","mean","median","IQR","sd","range","summary")
  theAggregateFun = gdroplist(aggregateFuns, editable=TRUE)

  ## Should have "TRUE" here as well, but get wierd condense error
  defMarginVals = c("FALSE","TRUE","grand_col","grand_row")
  theMargins = gdroplist(defMarginVals)

  theSubset = gedit("", width=75)

  possDotsVals = c("","na.rm = TRUE")
  theDots = gdroplist(possDotsVals, editable=TRUE, width=75)

  clearFormulaButton = gbutton("clear")
  editSubsetButton = gbutton("edit")
  updateButton = gbutton("update")
  
  ## the layout
  glabel("Cast a melted data set", cont=g)
  
  layout = glayout(cont=g)

  layout[1,1] = glabel("data:")
  layout[1,2] = theData

  layout[2,1] = glabel("variables:")
  layout[2,2] = theVariables
      
  layout[3,1] = glabel("formula:")
  layout[3,2] = colFormula
  layout[3,3] = clearFormulaButton

  layout[4,2] = glabel(" ~ ")
  layout[5,2] = rowFormula
  
  layout[6,1] = glabel("fun.aggregate:")
  layout[6,2] = theAggregateFun

  layout[7,1] = glabel("margins:")
  layout[7,2] = theMargins
  
  layout[8,1] = glabel("subset:")
  layout[8,2] = theSubset
  layout[8,3] = editSubsetButton

  layout[9,1] = glabel("...")
  layout[9,2] = theDots

  layout[10,2] = updateButton
  
  visible(layout) <- TRUE

  ## preview
  add(g,gseparator(horizontal=TRUE))
  previewGroup = gexpandgroup("Preview",cont=g)
  thePreview  =  glabel("")
  add(previewGroup, thePreview, expand=TRUE) # use delete/add to chnage
  visible(previewGroup) <- TRUE              # open as default

  ## saveAs area
  add(g,gseparator(horizontal=TRUE))
  saveAsGroup = ggroup(cont=g)
  saveAsButton = gbutton("Save output as:",cont=saveAsGroup)
  saveAs = gedit("",cont=saveAsGroup)

  ##################################################
  ## helper functions
  getCast = function() {
    ## gather pieces and call cast. Return FALSE if there is an error

    ## get the data set
    theName = svalue(theData)
    theVals = try(get(theName),silent=TRUE)
    if(inherits(theVals,"try-error") || !is.data.frame(theVals)) {
      msg = paste(theName,"does not refer to a data frame or matrix",sep=" ",collapse="")
      return(list(value=msg, flag=FALSE))
    }

    ## get ready
    ## margins
    marVal<-svalue(theMargins)
    if(is.null(marVal)) marVal = FALSE  # no margins
    if(marVal %in% c("FALSE","TRUE")) marVal <- as.logical(marVal)
    
    ## subset is a character, need to get logical
    subsetVal = svalue(theSubset)
    if(subsetVal == "")
      subsetVal = TRUE
    else
      subsetVal = eval(parse(text=subsetVal), envir=theVals)

    ## get the formula
    ## don't do this if not set yet
    if(svalue(colFormula) == defColFormText ||
       svalue(rowFormula) == defRowFormText) {
      cat("Drop more variables into formula\n")
      return(list(value="",flag=NULL))
    }
    
    theFormula = as.formula(paste(
      svalue(colFormula),
      "~",
      svalue(rowFormula),
      sep="",collapse="")
      )

    
    theArgs = list(
      data=theVals,
      formula = theFormula,
      "fun.aggregate" = svalue(theAggregateFun), 
      margins = marVal,
      subset = subsetVal
      )

    ## the dots
    if((theDotsVal <- svalue(theDots)) != "") {
      ## need to split on "="
      tmp = splitAndStrip(theDotsVal,"=")
      ## assign
      theDotsValue = eval(parse(text=tmp[2]),envir=.GlobalEnv)
      theArgs[[tmp[1]]] <- theDotsValue
    }

    
    ## this is so errors do show up
    theCast = do.call("cast",theArgs)
    
#    theCast = try(do.call("cast",theArgs), silent=TRUE)
    if(inherits(theCast,"try-error")) {
      ## error
      return(list(value=theCast,flag=FALSE))
    } else {
      return(list(value=theCast,flag=TRUE))
    }
  }
  
  cleanPreview = function() {
    delete(previewGroup, thePreview)
    thePreview <<- glabel("")
    add(previewGroup, thePreview, expand=TRUE)
##    enabled(thePreview) <- FALSE
  }    

  
  ##################################################
  ## handlers

  addhandlerchanged(theData, handler=function(h,...) {
    theName = svalue(theData)
    theVals = try(get(theName),silent=TRUE)
    ## verify data frame is good

    ## CHECK::HOW TO CHECK IF IS A MELTED OBJECT?
    if(inherits(theVals,"try-error") || !is.data.frame(theVals)) {
      gmessage(paste(theName,"does not refer to a data frame or matrix",sep=" ",collapse=" "))
      return()
    }

    ## otherwise, this is good
    ## add to variable list
    ID.vars = c(".",sort(names(theVals)),"...")
    ID.vars = ID.vars[ID.vars != "value"]

    
    theVariables[,] <- data.frame(ID.vars = ID.vars, stringsAsFactors=FALSE)


    ## clearout values
    svalue(colFormula) <- defColFormText
    svalue(rowFormula) <- defRowFormText
    svalue(theAggregateFun, index=TRUE) <-1
    ## add variables to marings
    theMargins[]<-c(defMarginVals, rev(rev(names(theVals))[-(1:2)]))
    

    svalue(theSubset) <- ""
    cleanPreview()
  })


  formulaDropHandler = function(h,...) {
    curText = svalue(h$obj)
    if(curText == defColFormText || curText == defRowFormText) {
      svalue(h$obj) <- h$dropdata
    } else {
      svalue(h$obj) <- paste(curText,h$dropdata, sep=" + ",collapse="")
    }

    updateHandler(list())
  }

  adddroptarget(colFormula, handler=formulaDropHandler)
  adddroptarget(rowFormula, handler=formulaDropHandler)

  updateHandler = function(h,...) {
    theCast = getCast()

    if(is.null(theCast$flag)) return(FALSE)
    
    if(theCast$flag == FALSE) {
      gmessage(theCast$value)
      return()
    }
    theCast = theCast$value             
    theCast = as.data.frame(theCast)    # chop off class cast_df gives gdf fits

    ## now update preview
    if(is.data.frame(theCast)) {
      delete(previewGroup, thePreview)
      thePreview <<- gtable(head(theCast, n = 15))
      
      add(previewGroup, thePreview, expand=TRUE)
##      enabled(thePreview) <- FALSE
    } else {
      ## something more complicated
      cat("DEBUG: something more complicated\n")
    }
    ## allow saving
    enabled(saveAsGroup) <- TRUE
  }

  ## active, these things
  addhandlerchanged(colFormula, handler = updateHandler) 
  addhandlerchanged(rowFormula, handler = updateHandler)
  addhandlerchanged(theAggregateFun, handler = updateHandler)
  addhandlerchanged(theMargins, handler = updateHandler)
  addhandlerchanged(theSubset, handler = updateHandler)
  addhandlerchanged(theDots, handler = updateHandler) 
  addhandlerchanged(updateButton, handler = updateHandler) 
  
  ## clear
  clearFormulaHandler = function(h,...) {
    svalue(colFormula) <- defColFormText
    svalue(rowFormula) <- defRowFormText

    delete(previewGroup, thePreview)
    thePreview <<- glabel("")
      
    add(previewGroup, thePreview, expand=TRUE)
##    enabled(thePreview) <- FALSE
    
  }
  
  addhandlerchanged(clearFormulaButton, handler=clearFormulaHandler)

  editSubsetHandler = function(h,...) {
    
    ## we need to have theData set properly
    theName = svalue(theData)
    theVals = try(get(theName),silent=TRUE)
    ## verify data frame is good

    ## CHECK::HOW TO CHECK IF IS A MELTED OBJECT?
    if(inherits(theVals,"try-error") || !is.data.frame(theVals)) {
      gmessage("first set a data value")
      return()
    }

    ## this is exported from gWidgets
    editSubsetDialog(theName, widget=theSubset)
    
  }
  addhandlerchanged(editSubsetButton, handler=editSubsetHandler)

  ## Save as
  saveAsHandler = function(h,...) {
    theVals = getCast()
    
    if(theVals$flag == FALSE) {
      gmessage(paste("Can't save, an error",
                     theVals$value,
                     sep="",collapse=""))
      return()
    }

    varName = svalue(saveAs)
    ## check
    if(varName == "") {
      gmessage("No variable name specified")
      return()
    }
    if(exists(varName, envir=.GlobalEnv)) {
      val = gconfirm(paste("Overwrite value for",varName,"?",sep=" "))
      if(val == FALSE)
        return()
    }
    
    assign(varName, theVals$value, envir=.GlobalEnv)
    enabled(saveAsGroup) <- FALSE

  }
  addhandlerchanged(saveAsButton, handler=saveAsHandler)
  addhandlerchanged(saveAs, handler=saveAsHandler)

  invisible()
}

### Helpers
splitAndStrip = function(x, pat) {
  tmp = unlist(strsplit(x,pat, perl=TRUE))
  sub('\\s+$', '', tmp, perl = TRUE) # trim white space
  sub('^\\s+', '', tmp, perl = TRUE) 

  return(tmp)
}
#line 1 "d:/Rcompile/CRANpkg/local/2.12/pmg/R/zzz.R"

## called on startup
## .First.lib = function(...) {
##   cat("\n\nP M G\n")
##   cat("To restart pmg, use the command:\n")
##   cat("pmg()\n")

##   pmg()
## }

## when we have a namespace, we can do this.
.onLoad <- function(...){
  cat("Loading pmg()\n")
  pmg()
}
