.packageName <- "Rggobi"
ggobi.home <-
function()
{
 "/usr/lib/ggobi"
}

ggobi.find.file <-
function(file, fatal = TRUE)
{
 if(file.exists(file))
   return(file)

 fn <- paste(ggobi.home(), file, sep=.Platform$file.sep)
 if(file.exists(fn))
  return(fn)
 
 if(fatal)
   stop("Cannot find file", file)
 else
   warn("Cannot find file", file)
}
# These are functions that encapsulate the names
# of the exact form of the C-level symbols that
# implement the R/SPlus ggobi interface.
# These allow us to change the prefix used for these symbols
# in order to avoid name conflicts with other packages, etc.


.ggobi.symbol <-
#
# A simple way of generating the prefix for a symbol
# used in this package/library so that we can hide
# it from other packages and avoid conflicts.
#
function(name)
{
  paste("RS_GGOBI", name, sep="_")
}


.GGobiCall <-
#
# Convenience function for calling
# routines within the GGobi chapter
# in the same manner as .Call()
#
function(name, ..., .gobi = getDefaultGGobi())
{
 if(missing(.gobi))
  stop("It is rare that the .gobi argument is missing. Probably a mistake")

 if(is.numeric(.gobi))
   .gobi <- as.integer(.gobi-1)

 .Call(.ggobi.symbol(name),..., .gobi)
}

.GGobiC <-
# Convenience function for calling
# routines within the GGobi chapter
# in the same manner as .C()
#
function(name, ..., .gobi = getDefaultGGobi())
{
 if(missing(.gobi))
  stop("It is rare that the .gobi argument is missing. Probably a mistake")

 if(is.integer(.gobi))
   .gobi <- as.integer(.gobi-1)
 else if(inherits(.gobi, "ggobi")) {
   .gobi <- unclass(.gobi)[["ref"]]
 } else
   stop("The .gobi argument should be an integer or an object of class ggobi")
 .C(.ggobi.symbol(name),..., .gobi)
}

#
# This file contains functions to control the handlers
# for numbered key press events. It allows one to 
# register and un-register functions for specific keys.

NumberedKeyHandler.ggobi <-
function(...)
{
 handlers <- list()
 defaultHandler <- NULL

  addHandlers <- 
  function(...) {
     args <- list(...)
     if(any(is.na(match(names(args), as.character(0:9))))) {
        stop("Handlers must be identified by a name corresponding to one of the keys 0,..,9")
     }
     handlers[names(args)] <<- args
  }

  addDefaultHandler <-
  function(h) {
    defaultHandler <<- h
  }

  removeHandlers <-
  function(...) {
    which <- as.character(unlist(...))    
    idx <- match(which, names(handlers),nomatch=0)
    handlers <<- handlers[-idx]
  }

  internalHandler <-
  function(key, plot = NULL, ggobi = NULL, ev = NULL) {

   if(length(handlers) > 0 && !is.na(match(as.character(key), names(handlers)))) {
      f <- handlers[[as.character(key)]]
      f(key, plot, ggobi, ev)
   } else if(!is.null(defaultHandler))
       defaultHandler(key, plot, ggobi, ev)
    else 
       return(F)

    T
  }


 # The internalHandler must be last in this list. 
 # Please, please, ... make it the last one.
 return(list(addHandlers=addHandlers, removeHandlers=removeHandlers,
             addDefaultHandler = addDefaultHandler, 
             defaultHandler = function(){ return(defaultHandler) },
             handlers = function(){ return(handlers) },
             internalHandler = internalHandler))
}


addNumberedKeyHandler.ggobi <-
function(..., .gobi=getDefaultGGobi())
{
 handler <- .GetNumberedKeyHandler.ggobi(T, .gobi=.gobi)
 handler$addHandlers(...)

 invisible(handler)
}

.GetNumberedKeyHandler.ggobi <-
#
# This interacts with the C internals to see if there is 
# already an R handler registered for the numbered keys. If
# there is, it returns that object. Otherwise, if create == T,
# it creates one by calling NumberedKeyHandler()
# (or uses the one specified as the argument to create if that 
function(create = F, register=T, .gobi= getDefaultGGobi())
{
  handler <- .GGobiCall("getNumberedKeyHandler", .gobi=.gobi)

  if(is.null(handler) && ( (is.logical(create) && create) || is.list(create))) {
   if(is.logical(create))
    handler <- NumberedKeyHandler.ggobi()
   else 
    handler <- create

    if(register)
      registerNumberedKeyHandler.ggobi(handler, .gobi=.gobi)  
  }

 handler
}

registerNumberedKeyHandler.ggobi <-
#
# Registers the specified handler with the specified ggobi instance
# as the event handler for key presses on the number keys.
#
function(handler = NumberedKeyHandler.ggobi(), .gobi= getDefaultGGobi(), description="R numbered key press event handler")
{
 .GGobiCall("setNumberedKeyHandler", handler, description, .gobi = .gobi)

 return(handler)
}
#
# These functions create a ``virtual'' description 
# of a ggobi plot without actually creating the plot.
# They act as templates allowing the user to create
# descriptions that can be resolved or instantiated
# into real ggobi plots.
#
# See plotLayout() which takes a collection of these
# plot descriptions and a layout specification and
# creates a new display with the instantiated plots.

parallelCoordDescription <-
function(..., .data = -1, .gobi=NULL)
{
  pl <- list(vars = c(...), ggobi=.gobi, .data=.data)
  class(pl) <- ifelse(length(pl$vars) > 1, "MultipleParallelCoordinates", "ParallelCoordinates")

 pl
}

ashDescription <-
function(x, .data = -1, .gobi=NULL)
{
  pl <- list(vars = x, ggobi=.gobi, .data=.data)
  class(pl) <- "GGobiAsh"

 pl
}

scatterplotDescription <-
function(x, y, .data = -1, .gobi=NULL)
{
  pl <- list(vars = c(x, y), ggobi=.gobi, .data=.data)
  class(pl) <- "ScatterPlot"

 pl
}

scatmatrixDescription <-
function(..., .data = -1, .gobi=NULL)
{
  pl <- list(vars = c(...), ggobi=.gobi, .data = .data)
  class(pl) <- "ScatmatrixPlot"

  pl
}

timeseriesDescription <-
function(..., .data = -1, .gobi = NULL)
{
 pl <- list(vars=c(...), ggobi=.gobi, .data = .data)
 class(pl) <- "TimeSeriesPlot"

 pl
}


plotList <-
function(..., mfrow = NULL, cells = NULL)
{
  plots <- list(plots = list(...), mfrow = mfrow, cells = cells)
  class(plots) <- "ggobiPlotList"

 return(plots)
}


resolvePlotDescription <- 
# 
# Transforms variable names into indices 
# by resolving them relative to the specified
# dataset within the given 
#
function(desc, .data = 1, .gobi = getDefaultGGobi(), isError = T)
{
 if(is.null(desc))
   return(NULL)

 if(is.character(desc$vars)) {
   if(!is.null(desc$ggobi)) {
     .gobi <- desc$ggobi
   } else
     desc$ggobi <- .gobi

   if(desc$.data > -1) {
    .data <- desc$.data
   } else
    desc$.data <- .data

   nms <- getVariableNames.ggobi(.data = .data, .gobi= .gobi)

   idx <- match(desc$vars, nms)
   if(any(is.na(idx)) && isError) 
     stop(paste("Cannot resolve variable name", desc$vars[is.na(idx)],"in ggobi"))

   desc$vars <- idx
 } else {
   desc$vars <- as.integer(desc$vars)
   if(desc$.data < 0)
     desc$.data <- .data
   if(is.null(desc$ggobi)) 
     desc$ggobi <- .gobi
 }

 desc
}


setSmootherFunction.ggobi <-
# Returns the previous setting of this internal variable
# that controls how the smoothing is done when the
# GGobi window width slider is moved.
function(fun, .ggobi = -1, .gobi = getDefaultGGobi())
{
 return(.GGobiCall("setSmoothFunction", fun, .gobi = .gobi))
}


getSmootherFunction.ggobi <-
function(.gobi = getDefaultGGobi())
{
 return(.GGobiCall("getSmoothFunction"), .gobi = .gobi)
}

getSelectedIndices.ggobi <-
#
# only indicates whether the return value
# should contain only the indices 
# of the points that are within in the brush region
# or whether it should be a logical vector
# indicating whether 
#
# The reason for this is efficiency.
#
#
function(.data = 1, .gobi = getDefaultGGobi())
{
  if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)

 .GGobiCall("getSelectedIndices", .data, .gobi=.gobi)
}

isObservationSelected.ggobi <-
function(.data = 1, .gobi = getDefaultGGobi())
{
  if(!inherits(.data, "ggobiDataset"))
    .data <- getDatasetReference.ggobi(.data, .gobi)

  sel <- getSelectedIndices.ggobi(.data, .gobi)
  n <- nrow(.data)

  if(is.null(sel))
    ans <- logical(n)
  else {
    ans <- !is.na(match(seq(1, length = n), sel))
  }

 return(ans)
}

getBrushSize.ggobi <-
function(.data = 1, .gobi = getDefaultGGobi(), units=0)
{
   # This is not a mistake. Passing negative dimensions
   # means that we just get the current value back and skip
   # the setting.
 setBrushSize.ggobi(as.integer(-1), as.integer(-1), .gobi=.gobi)
}

getBrushLocation.ggobi <-
function(.data=1, .gobi = getDefaultGGobi(), units=0)
{
 setBrushLocation.ggobi(as.integer(-1), as.integer(-1), .data, .gobi=.gobi)
}

setBrushSize.ggobi <-
function(w, h, .data = 1, .gobi = getDefaultGGobi(), update = T, units = 0)
{
 if(length(w) > 1 && missing(h)) { 
   w <- as.integer(w)
   h <- as.integer(w[2]) 
 }

 if(mode(.data) == "numeric")
   .data <- as.integer(.data - 1)

 tmp <- .GGobiCall("setBrushSize", as.integer(c(w[1],h[1])), .data, .gobi = .gobi) 
 if(!is.null(tmp))
   names(tmp) <- c("width", "height")

 return(tmp)
}

setBrushLocation.ggobi <-
function(x, y, .data = 1, .gobi = getDefaultGGobi(), update = T, units = 0)
{
 if(length(x) > 1 && missing(y)) { 
   x <- as.integer(x)
   y <- as.integer(x[2]) 
 }

 if(mode(.data) == "numeric")
   .data <- as.integer(.data - 1)

 tmp <- .GGobiCall("setBrushLocation", as.integer(c(x[1],y[1])), .data, .gobi = .gobi)
 if(!is.null(tmp))
   names(tmp) <- c("x", "y")

 return(tmp)
}


setBrushColor.ggobi <-
function(id, .gobi = getDefaultGGobi())
{
 if(is.character(id)) {
   which <- match(id,  rownames(getColorMap.ggobi(.gobi)))
   if(any(is.na(which))) { 
     stop(paste("Unrecognized color(s)", id[is.na(which)]))
   }
   id <- which
 }
  .GGobiCall("setBrushColor", as.integer(id-1), .gobi=.gobi)
}

getBrushColor.ggobi <-
function(.gobi = getDefaultGGobi())
{
  .GGobiCall("getBrushColor", .gobi=.gobi)
}

setBrushGlyph.ggobi <-
function(type = -1, size = -1, .gobi = getDefaultGGobi())
{

 if(missing(type) & missing(size))
  stop("Must specify a glyph size or type")

 if(is.character(type)) {
   type <- mapGlyphType(type)
 }

 .GGobiCall("setBrushGlyph", as.integer(c(type, size)), .gobi=.gobi)
 return(T)
}

getBrushGlyph.ggobi <-
function(.gobi = getDefaultGGobi())
{
 x <- .GGobiCall("getBrushGlyph", .gobi = .gobi)
 if(is.null(x))
   return(x)

 n <- getGlyphTypes.ggobi()

 names(x) <- c( names(n)[x[1] == n], "size")
 x
}


mapGlyphType <-
function(types)
{

 if(is.character(types)) {
  sys.types <- getGlyphTypes.ggobi()
  ids <- match(types, names(sys.types))
  if(any(is.na(ids))) {
print(ids)
    stop(paste("Invalid glyph name(s):",paste(types[is.na(ids)], collapse=", ")))
  }
  types <- ids
 } else
  types <- as.integer(types)

 return(types)
}
checkStructs.ggobi <-
function()
{
  ours <- .Call(.ggobi.symbol("getStructSizes"), TRUE)
  theirs <- .Call(.ggobi.symbol("getStructSizes"), FALSE)

  which <- match(names(ours), names(theirs))
  if(any(is.na(which)))
    stop(paste("No information about some struct(s):", paste("`", names(ours)[is.na(which)],"'", collapse=", ", sep="")))

  ok <- ours == theirs[which]
  if(!all(ok)) {
    warning("some structs have different size")
    return(ok)
  }

  TRUE
}

getColorSchemes <-
function(.gobi = NULL)  
{
 .GGobiCall("getColorSchemes", .gobi = .gobi)
}  


addColorScheme <-
function(scheme, name, overwrite = FALSE, set = FALSE, .gobi = NULL)  
{
    # compute the type based on the class.
  type <- as.integer(0)
  ans <- .GGobiCall("addColorScheme",
                    scheme$colors, scheme$background,
                    scheme$annotations, type,
                    as.character(name),
                    as.logical(overwrite), .gobi = .gobi)

  if(set)
    setActiveColorScheme(name, .gobi = .gobi)

  ans
}  

setActiveColorScheme <-
function(id, .gobi = NULL)
{
  if(is.numeric(id))
    id <- as.integer(id)
  
 .GGobiCall("setActiveColorScheme", id, .gobi = .gobi)
}
describe.ggobi <-
function(..., full = F)
{
 args <-list(...)
 if(length(args) == 0)
   args <- list(getDefaultGGobi())

 .Call("RS_GGOBI_describeGGobis", args, as.logical(full))
}
setDisplayWidth.ggobi <-
function(sz,  display = 1, .gobi = getDefaultGGobi() )
{
 .GGobiCall("setDisplayWidth", 
           dims = as.integer(sz), as.integer(display - 1), .gobi = .gobi)
}

getDisplayWidth.ggobi <-
function(display = 1, .gobi = getDefaultGGobi() )
{
  setDisplayWidth.ggobi(NULL, display, .gobi)

}

getVariable.ggobi <-
function(which, .data = 1, .gobi = getDefaultGGobi(), asDataFrame = F)
{
  idx <- getVariableIndex.ggobi(which, .data = .data, .gobi = .gobi)
  if(any(is.na(idx))) {
    stop(paste("Unmatched variable name", which[is.na(idx)],"in ggobi"))
  }

  varNames <- getVariableNames.ggobi(.data = .data, .gobi = .gobi)[idx]
  if(asDataFrame)
    rowNames <- getRowNames.ggobi(.data = .data, .gobi = .gobi)

  if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)

  vals <- .GGobiCall("getVariables", as.integer(idx), .data, .gobi=.gobi)
  names(vals)  <- varNames

  if(asDataFrame)
    vals <- data.frame(vals, row.names = rowNames, check.names = FALSE)

  vals
}
"[[.ggobi" <-
#
# Extracts a subset of the data in the specified
# ggobi
#
# Example:
#  g <- ggobi(mtcars)
#  g[1][1:20,]
#   .... # make selections
#  setMode.ggobi("brush")     # or programmatically
#  setBrushSize.ggobi(300,300)
#  g[1][isObservationSelected.ggobi(g),]
#
function(x, ...,drop=F)
{
  v <- getDatasetReference.ggobi(sapply(list(...), function(x) 
                                     if(mode(x) == "numeric") 
                                       as.integer(x)
                                     else
                                       as.character(x)
                                  ), .gobi = x)

  if(!inherits(v, "ggobiDataset"))
    stop("attempt to select more than one GGobi dataset")

   v
}

"[.ggobi" <-
# This should be fixed up to return a list at all times
# and not a dataset or a list of datasets.
function(x, ...,drop=F)
{
  getDatasetReference.ggobi(sapply(list(...), function(x) 
                                     if(mode(x) == "numeric") 
                                       as.integer(x)
                                     else
                                       as.character(x)
                                  ), .gobi = x)

}


"[<-.ggobiDataset" <-
function(x, i, j, value)
{
 tmp <- x
 x <- getData.ggobi(.data=x)

  x <- do.call("[<-",list(x,i,j,value))
  idx <- 1:nrow(x)
  for(i in 1:ncol(x)) {
    setVariableValues.ggobi(x[,i], i, idx, .data = tmp)
  }
 tmp
}


"[[<-.ggobiDataset" <-
function(x, i, j, value)
{
  if(is.character(j))
    vars <- getVariableIndex.ggobi(j, .data=x)
  else
    vars <- j

  val <- rep(value, length = length(i))
  for(v in vars) {
    setVariableValues.ggobi(val, v, i, .data = x)
  } 

  x
}

"[.ggobiDataset" <-
#
# Allows the internal dataset to be
# subsetted as if it were local.
# Actually, this currently pulls the entire dataset
# across into R and then subsets. This can be made
# more intelligent if needed.
function(x,..., drop=F)
{
 x <- getData.ggobi(.data = x)
 NextMethod("[")
}


getData.ggobi <-
function(.data = 1, .gobi = getDefaultGGobi())
{
  if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)

  .GGobiCall("getData", .data, .gobi=.gobi)
}

nrow.ggobiDataset <-
function(d)
{
 dim(d)[1]
}

ncol.ggobiDataset <-
function(d)
{
 dim(d)[1]
}

names.ggobiDataset <-
function(x)
{
 getVariableNames.ggobi(F, x, .gobi = x[["ggobi"]])
}

dimnames.ggobiDataset <-
function(d)
{
  list(getRowNames.ggobi(d, .gobi=d[["ggobi"]]), names(d))
}

dim.ggobiDataset <-
#
# Gets the dimensions of the 
#  
function(d)
{
  .Call(.ggobi.symbol("datasetDim"), d)
}


names.ggobi <-
function(x)
{
 getDatasetNames.ggobi(x)
#  getVariableNames.ggobi(.gobi=x)
}


if(FALSE) {

  dim.ggobi <-
  function(x) {
     d <- getDescription.ggobi(.gobi = x)
     d[[3]]
  }

  nrow.ggobi <-
  function(x) {
    dim(x)[1]
  }

  ncol.ggobi <-
  function(x) {
    dim(x)[1]
  }

  dimnames.ggobi <-
  function(x)  {
    list (getRowNames.ggobi(.gobi=x), names(x))
  }

  "[<-.ggobi" <-
  function(x, ...,drop=F)  {
    g <- getData.ggobi(.gobi=x)
    UseMethod("[",...)
  }

}
ggobi <-
#
# Start a ggobi session
# data can be the name of a file, or data frame or matrix.
#
# Returns the index of the ggobi instance within 
# the session. If an error occurs, -1 is returned.
#
# see setData.ggobi
#     setDataFile.ggobi
#
function(data = NULL, args=character(0), mode=character(0))
{
 args <- c("ggobi", c("--keepalive", as.character(args)))

 if(!missing(data) && is.character(data)) {
  args <- c(args, as.character(mode), data)
  data <- NULL
 }

 ok <- .Call(.ggobi.symbol("init"), args, TRUE)

 if(!is.null(ok)) {
   # So we didn't get an error.
   # Set this new ggobi to be default instance
   # so that subsequent commands will operate
   # on it.
  setDefaultGGobi(ok) 

   #
  if(!missing(data) && !is.null(data))
    setData.ggobi(data, .gobi = ok)
 }

 return(ok)
}

setData.ggobi <-
function(data, ..., .gobi = getDefaultGGobi())
{
 if(is.character(data)) {
  ok <- setDataFile.ggobi(data, ..., .gobi = .gobi)
 } else
  ok <- setDataFrame.ggobi(as.data.frame(data), ..., .gobi = .gobi)

 return(ok)
}


setDataFile.ggobi <-
function(file, mode = "unknown", add = T, .gobi = getDefaultGGobi())
{
 if(is.character(file)) {
   modes <- getDataModes.ggobi()
   mode <- match(mode, modes)
   if(is.na(mode)) {
     mode <- modes["Unknown"]
   } else
     modes <- modes[mode]
 }

 num <- .GGobiCall("setFile", as.character(file), as.integer(mode), as.logical(add), .gobi = .gobi)
 if(num > -1) {
   getDatasetReference.ggobi(num, .gobi)
 } else
   NULL
}


getNumDatasets.ggobi <-
function(.gobi = getDefaultGGobi())
{
 .GGobiCall("getNumDatasets", .gobi=.gobi)
}

getFileNames.ggobi <-
#
# Get the name and mode of the file
# associated with the current dataset.
function(auxillary = FALSE, .gobi = getDefaultGGobi())
{
  .GGobiCall("getFileNames", as.logical(auxillary), .gobi = .gobi)
}

setDataFrame.ggobi <-
function(data, name = description, description = deparse(sys.call()[[2]]), 
            add = TRUE, id = rownames(data), .data = NULL, .gobi = getDefaultGGobi())
{

 # description was 

 n <- dimnames(data)
 if(!inherits(.gobi, "ggobi")) {
   .gobi <- getGGobi(as.integer(.gobi))
 }

  if(length(id) != nrow(data)) {
    id <- paste(seq(1, nrow(data)))
  }

# .gobi <- as.numeric(unclass(.gobi)[["ref"]])
 num <- .Call(.ggobi.symbol("setData"),
           as.numeric(as.matrix(data)),
           n[[1]], n[[2]], dim(data), 
           as.character(description), as.character(name), as.logical(add),
           as.character(id), .data, .gobi = .gobi)$num

 getDatasetReference.ggobi(num, .gobi)
}

getDatasetReference.ggobi <-
function(which, .gobi = getDefaultGGobi())
{
 if(is.character(which)) {
   id <- match(which, getDatasetNames.ggobi(.gobi))
   if(any(is.na(id)))
     stop(paste("Unrecognized dataset name", which[is.na(id)]))

   which <- id
 }

 refs <- .GGobiCall("getDatasetReference", as.integer(which-1), .gobi=.gobi)

  # if the user just asked for one, then return not a list,
  # but the actual ggobiDataset object. i.e. remove the list.
 if(length(which) == 1 & length(refs) == 1) {
   refs <- refs[[1]]
 }

 refs
}

getDatasetReference <-
function(which,...)
{
 UseMethod("getDatasetReference")
}

getDatasetReference.ggobiDisplayDescription <-
function(which)
{
  which[["dataset"]]
}

getDatasetReference.ggobiDisplay <-
function(which)
{
  getDisplayDataset.ggobi(which)
}

getDisplayDataset.ggobi <-
function(dpy, .gobi = getDefaultGGobi())
{
 .GGobiCall("getDisplayDataset", dpy, .gobi = .gobi)
}


getCurrentDisplayType.ggobi <-
#
# Returns a description of the type
# of display which is the active or current
# one.
#
function(.gobi = getDefaultGGobi())
{
  .GGobiCall("getCurrentDisplayType", .gobi = .gobi)
}


getDisplayTypes.ggobi <-
function()
{
 .Call(.ggobi.symbol("getDisplayTypes"))
}

getViewTypes.ggobi <-
# Returns a named integer vector
# identifying the  symbolic constants
# for the different types of plots, indexed
# by the descriptive name of the plot type.
function()
{
  .Call(.ggobi.symbol("getViewTypes"))
}

getDisplayOptions.ggobi <-
#
# Retrieve the display options for the 
# specified display. The default is to get
# the template default options which are used when
# creating a new display/plot.
# Alternatively, one can specify an integer which identifies
# the display (window) and its sub-plots.
# These are stored in ordered and can be examined using
# the hierarchical display tree accessed from the Plots
# menu item.

#
# which - the display number within the specified ggobi instance.
#

function(which = 1, .gobi = getDefaultGGobi())
{
  .GGobiCall("getDisplayOptions", as.integer(which-1), .gobi = .gobi)
}


setDisplayOptions.ggobi <-
#
# Changes the settings of the display options for a
# collection of plots or the template options for future
# plots.
#
#
# The argument `which' identifies the GGobi display (this is an index
# into the ordered list of displays viewable via the hierarchical dislay
# tree). If this is negative, the Default options used when creating new
# plots will be modified.
#
# The return value is the current settings for the specified options.
#
# Need to handle the case where the user specifies a single vector of
# logicals. And named vectors.
#
#
function(points, directed, undirected, segments, missings,  axes, 
           display = 1, .gobi = getDefaultGGobi())
{
  current <- getDisplayOptions.ggobi(display, .gobi=.gobi)
  old <- current

  if(!missing(points))
    current["Points"] <- as.logical(points)

  if(!missing(segments))
    current["Segments"] <- as.logical(segments)

  if(!missing(directed))
    current["Directed segments"] <- as.logical(directed)

  if(!missing(undirected))
    current["Undirected segments"] <- as.logical(undirected)

  if(!missing(missings))
    current["Missing Values"] <- as.logical(missings)

  if(!missing(axes))
    current["Axes"] <- as.logical(axes)

  .GGobiCall("setDisplayOptions", as.integer(display - 1), current, .gobi = .gobi)

 return(old)
}



getActivePlot.ggobi <-
function(.gobi = getDefaultGGobi())
{
 as.integer(.GGobiCall("getActivePlot", .gobi = .gobi)+1)
}

setActivePlot.ggobi <-
function(display, plot=1, .gobi = getDefaultGGobi())
{
 .GGobiCall("setActivePlot", as.integer(c(display, plot)-1), .gobi = .gobi)
}

getDisplays.ggobi <-
function(describe = F, .gobi = getDefaultGGobi())
{
 .GGobiCall("getDisplays", as.logical(describe), .gobi = .gobi)
}


close.ggobiDisplayDescription <-
function(con, ...)
{
 close(con[["display"]])
}

close.ggobiDisplay <-
function(con, ...)
{
  .GGobiCall("closeDisplay", con[["ref"]], .gobi = con[["ggobi"]])
}

getDatasetNames.ggobi <-
function(.gobi = getDefaultGGobi())
{
 .GGobiCall("getDatasetNames", .gobi=.gobi)
}

getDescription.ggobi <-
#
# Get a description of the global state of the GGobi session.
# 
#
function(.gobi = getDefaultGGobi())
{
  .GGobiCall("getDescription", .gobi = .gobi)
}



getVariableNames.ggobi <-
function(tform = FALSE, .data = 1, .gobi = getDefaultGGobi())
{
  if(!inherits(.gobi, "ggobi"))
   .gobi <- getGGobi(.gobi = .gobi)

  if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)

  .GGobiCall("getVariableNames", as.logical(tform), .data, .gobi = .gobi)
}

datasetIndex.ggobi <-
function(.data, .gobi = getDefaultGGobi())
{
 if(is.integer(.data))
   return(.data)

 if(mode(.gobi) == "numeric")
   .gobi <- getGGobi(.gobi)
 
 index <- match(as.character(.data), names(.gobi))
 names(index) <- .data

 return(index)
}


getGlyphTypes.ggobi <-
function()
{
 .Call(.ggobi.symbol("getGlyphTypes"))
}

getGlyphSizes.ggobi <-
function()
{
 .Call(.ggobi.symbol("getGlyphSizes"))
}


getGlyphs.ggobi <-
function(which=NULL, .data = 1, .gobi = getDefaultGGobi())
{
 if(mode(.data) == "numeric")
   .data <- as.integer(.data - 1)

 if(!is.null(which)) {
   which <- as.integer(which-1)
 }

 .GGobiCall("getCaseGlyphs", which, .data, .gobi = .gobi)
}

setGlyphs.ggobi <-
function(types, sizes, which, .data=1, .gobi = getDefaultGGobi())
{
 if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)

 if(is.character(types)) {
    # map the glyph types to integers
   types <- mapGlyphType(types)
 }

 if(missing(which))
   which <- seq(1, length = length(types))

 if(missing(sizes)) {
   sizes <- rep(-1, length(types))
 }

 m <- max(length(which), length(sizes), length(types))
 which <- rep(which, length.out = m)
 sizes <- rep(sizes, length.out = m)
 types <- rep(types, length.out = m)

 if(any( c(length(which), length(sizes), length(which)) == 0))
   stop("Non-zero glyph attributes needed")

 .GGobiCall("setCaseGlyphs", as.integer(types), as.integer(sizes), as.integer(which-1), .data, .gobi = .gobi)
}


getColors.ggobi <-
function(which = NULL, .data = 1, .gobi = getDefaultGGobi())
{
 if(mode(.data) == "numeric")
   .data <- as.integer(.data - 1)

 .GGobiCall("getCaseColors", as.integer(which), .data,  .gobi = .gobi)
}

setColors.ggobi <-
function(colors, which = 1:length(colors), .data=1, .gobi = getDefaultGGobi())
{
 if(mode(colors) == "numeric")
   colors <- as.integer(colors)
 else {
   tmp <-  resolveColors.ggobi(as.character(colors), .gobi = .gobi)
   if(any(is.na(tmp)))
     stop(paste("Unspecified color(s)", colors[is.na(tmp)]))

    colors <- tmp
 }

 if(mode(.data) == "numeric")
   .data <- as.integer(.data - 1)

 if(any(colors < 1) || any(colors > 65535))
    stop("All color indices must be positive and less than 65536.")
 
 old <- .GGobiCall("setCaseColors", old=colors, as.integer(which-1), .data, .gobi = .gobi)
 invisible(old)
}

resolveColors.ggobi <-
function(..., .gobi = getDefaultGGobi())
{
  stop("Color names are not currently supported in ggobi")
  ids <- rownames(getColorMap.ggobi(.gobi=.gobi))
  match(c(...), ids)
}

getColorMap.ggobi <-
function(.gobi = getDefaultGGobi())
{
 m <- .GGobiCall("getColorMap", .gobi = .gobi)
 m <- m/65535

  # Now fix up the missing names for the colors
  # and give them their index values.
 n <- dimnames(m)[[1]]
 n[n==""] <- (1:length(n))[n==""]
 
 dimnames(m)[[1]] <- n
 m
}

setColorMap.ggobi <-
function(vals, .gobi = getDefaultGGobi(), scale=65535)
{
 if(!is.matrix(vals) | ncol(vals) != 3)
  stop("Color map must be an Nx3 matrix of RGB values")
 
 colorNames <- rownames(vals)
 .GGobiCall("setColorMap", as.numeric(vals * scale), colorNames, .gobi = .gobi)
}



close.ggobi <-
function(con, ...)
{
  if(missing(con))
     con <- getDefaultGGobi()
  
  ok <- .GGobiCall("close", .gobi = con)
  if(ok) {
    cur <-getDefaultGGobi()
    if(unclass(con)$ref == unclass(cur)$ref) {
      setDefaultGGobi(getNumGGobis()) 
    }
  }

 ok
}


getNumGGobis <-
function()
{
 .C(.ggobi.symbol("getNumGGobiInstances"), as.integer(-1))[[1]]
}

isValid.ggobi <-
function(.gobi)
{
 .GGobiCall("isValid", .gobi=.gobi)
}

getGGobi <-
function(...)
{
 args <- list(...)
 if(length(args) > 0) {
   which <- sapply(args, as.integer)
 } else {
   which <- as.integer(seq(1,length=getNumGGobis()))
 }

 if(length(which)) {
   v <- .Call("RS_GGOBI_getGGobi", which)
   if(!is.null(v) & length(which) == 1) {
    v <- v[[1]]
   }

   v
 } else
   NULL
}


setMode.ggobi <-
function(name, .gobi = getDefaultGGobi())
{
 old <- getMode.ggobi(.gobi) 
 .GGobiCall("setMode",  as.character(name), .gobi=.gobi)

 old
}

getMode.ggobi <-
function(.gobi = getDefaultGGobi())
{
 .GGobiCall("getModeName", .gobi=.gobi)
}

getModeNames.ggobi <-
function()
{
  .Call(.ggobi.symbol("getModeNames"))
}

getDataModes.ggobi <-
function()
{
 .Call(.ggobi.symbol("getDataModes"))
}


gdk.flush <-
function()
{
  .C(.ggobi.symbol("flush"))
}


getHiddenCases.ggobi <-
function(.data = 1, .gobi = getDefaultGGobi())
{
 if(mode(.data) == "numeric")
   .data <- as.integer(.data - 1)

 .GGobiCall("getCasesHidden", .data = .data, .gobi=.gobi)
}

setHiddenCases.ggobi <-
function(vals, which = 1:length(vals), .data = 1, .gobi = getDefaultGGobi())
{
 vals <- as.logical(vals)
 if(mode(.data) == "numeric")
   .data <- as.integer(.data - 1)

 .GGobiCall("setCasesHidden", vals, as.integer(which-1), .data = .data, .gobi=.gobi)
}
#
# These functions provide basic access to the
# underlying Gtk objects within the GGobi data
# structures. These can then be used with the RGtk
# package to combine plots in a different GtkContainer,
# specify event callback functions, etc.
#
#
# Want a way to be able to create a display without
# creating the window.
#

getDisplayWindow.ggobi <-
function(display = 1, .gobi = getDefaultGGobi(), expandClasses = TRUE)
{
#
# This returns an reference to the GtkWindow object
# associated with the given display.
#
# The value of display should be either an integer
# identifying by index the display of interest within the GGobi
# instance (.gobi), or an object of class ggobiDisplay
#  
#  
  if(is.numeric(display)) {
    display <- as.integer(display)
    display <- getDisplays.ggobi(FALSE, .gobi=.gobi)[[display]]
    
  }

  if(!inherits(display, "ggobiDisplay"))
    stop("Need an object of class ggobiDisplay")
  
  dpy <- .Call(.ggobi.symbol("getDisplayWindow"), display)

    # now put on the class information.
  if(!is.null(dpy) && expandClasses) {
     require(RGtk)
     class(dpy) <- gtkObjectGetClasses(dpy, check = FALSE)
  }

  dpy
}  

getPlotWidgets.ggobiDisplay <-
function(dpy, expandClasses = TRUE)  
{
#
# Get references to the GtkDrawingArea widgets
# of the splotd objects in the given display.
# The value of dpy should be an object of class
# ggobiDisplay and can be obtained using a call of the
# form
#    getDisplays.ggobi(FALSE)[[which]]
#  
 if(!inherits(dpy, "ggobiDisplay"))
    stop("Object must be of class ggobiDisplay")


 els <- .Call(.ggobi.symbol("getDisplayPlotWidgets"), dpy)
 if(expandClasses) {
   require(RGtk)  
   els <- lapply(els, function(x) {
                         class(x) <- gtkObjectGetClasses(x, check = FALSE)
                         x
                       })
 }

 els
}

setIdentifyHandler.ggobi <-
function(f, .gobi = getDefaultGGobi())
{
 .GGobiCall("setIdentifyHandler", f, .gobi = .gobi);
}
setPlotRange.ggobi <-
function(x, y, plot=1, display = 1, .gobi = getDefaultGGobi())
{
 stop("This is not implemented yet")
 length(x) <- 2
 length(y) <- 2

 plot <- as.integer(plot)
 if(mode(display) == "numeric")
    display <- as.integer(display - 1)
 .GGobiCall("setPlotRange", as.numeric(x), as.numeric(y), as.integer(plot), 
            display, .gobi=.gobi)
}

getPlotRange.ggobi <-
function(plot=integer(1), display = 1, .gobi = getDefaultGGobi())
{
 stop("This is not implemented yet")
 if(mode(display) == "numeric")
    display <- as.integer(display - 1)
 .GGobiCall("getPlotRange", as.integer(plot), display, .gobi=.gobi)
}
getEdges.ggobi <-
function(.data = 1, .gobi = getDefaultGGobi())
{
 if(is.numeric(.data))
   .data <- as.integer(.data - 1)

  m <- .GGobiCall("getConnectedEdges", .data, .gobi = .gobi)
  colnames(m) <- c("source", "destination")

  m
}


setEdges.ggobi <-
#
# x and y are vectors of equal length identifying the points
#
function(x, y, append=T, .data = 1, .gobi = getDefaultGGobi())
{
 if(missing(y)) {
  if(is.matrix(x)) {
    y <- x[,2]
    x <- x[,1]
  }
 } 

 if(length(x) != length(y)) {
    m <- min(length(x),length(y))
    length(x) <- m
    length(y) <- m
 }

 if(mode(.data) == "numeric") {
    if(.data <= getNumDatasets.ggobi(.gobi = .gobi))
      .data <- .gobi[[ .data ]]

  if(FALSE) {    
    if(!inherits(.data, "ggobiEdgeDataset")) {
      .data <- createEdgeData.ggobi(length(x), .gobi = .gobi)
    }
  }
 }

 if(mode(x) != mode(y))
   stop("x and y must have the same types")

 if(mode(x) == "character") {
   v <- .GGobiCall("setEdges", x, y, as.logical(append), 
                                       .data, .gobi=.gobi)
 } else 
   v <- .GGobiCall("setEdgeIndices", as.integer(x), as.integer(y), as.logical(append), 
                                       .data, .gobi=.gobi)
}



createEdgeData.ggobi <-
function(numEdges, labels=rep("", numEdges), colors = NULL, .gobi = getDefaultGGobi())
{
 d <- .GGobiCall("createEdgeDataset", as.integer(numEdges), .gobi = .gobi)

 setRowNames.ggobi(as.character(labels), .data = d)

 if(!is.null(colors))
  setColors.ggobi(colors, .data = d)

 d
}



setDisplayEdges.ggobi <-
function(displays, edgeData, directed = FALSE, .gobi = getDefaultGGobi())
{
 if(missing(displays))
    displays <- getDisplays.ggobi(.gobi = .gobi)

 if(inherits(displays, "ggobiDisplay"))
   displays <- list(displays)

 if(missing(edgeData)) {
   datasets <- getDatasetReference.ggobi(1:getNumDatasets.ggobi(.gobi=.gobi), .gobi = .gobi)
   e <- sapply(datasets, function(x) inherits(x, "ggobiEdgeDataset"))
   if(!any(e))
     stop("No edge data")

   k <- ((1:length(e))[e])[1] 
   edgeData <- datasets[[ k ]]
 } else {
   if(is.numeric(edgeData)) {
     edgeData <- .gobi[[edgeData]]
   }
 }

 if(!inherits(edgeData, "ggobiEdgeDataset"))
   stop("Not an edge dataset")

 .GGobiCall("setDisplayEdges", displays, edgeData, as.logical(directed), .gobi = .gobi)
}

"$.ggobi" <-
#
# This defines a syntax trick to allow calls of the form
#  (where g is an object of class ggobi)
#
# g$getDisplayCount() 
# g$setData(mtcars)
#
# which are really translations from
#  g$name(..)  ->  name.ggobi( ..., .gobi = g)
#
function(g, name)
{
 f <- get(paste(name,"ggobi",sep="."))

 return(function(...) { f(..., .gobi=g)} )
}


"$.ggobiDataset" <-
function(d, name)
{
 f <- get(paste(name,"ggobi",sep="."))

 return(function(...) { f(...,.data = d,  .gobi=d[["ggobi"]])} )
}



print.ggobi <-
function(x,...) {
 x <-paste("ggobi reference (", unclass(x)$id , ")", sep="")
 NextMethod("print",x)
}

print.ggobiDataset <-
function(x,...) {
 x <- paste("ggobi dataset (",
            names(x[["data"]]), ", ", unclass((unclass(x)$ggobi))[["id"]], ")", sep="")
 NextMethod("print",x,...)
}


"$.ggobi" <-
#
# The idea of this function is to simplify the syntax for invoking
# ggobi functions which use the .ggobi suffix.
# Users have different ggobi instances as S variables (i.e. not
# using indices or the default ggobi via getDefaultGGobi())
# and they invoke the methods on this instance via the OOP notation
#  
#     g$getPlotCount()
# and the `static'/class function
#     g$getViewTypes()
#
function(x, name)
{
 .funName <- paste(name,"ggobi",sep=".")
 if(exists(paste(.funName, mode="function"))) {
   .fun <- get(.funName, mode="function")
    # Check if the function has a .gobi argument to see if it
    # is an instance method or class method
    uses.ggobi <- !is.na(match(".gobi", names(formals(.fun))))
    if(uses.ggobi) {
      function(...) {
       .fun(...,.gobi=x)
      }
    } else {
     .fun
    }

    return(.fun)
 } else {
    do.call("$", list(unclass(x)[["ref"]], name))
 }
}

#
#
#
#
plotLayout <-
function(..., mfrow = NULL, cells = NULL, .data = 1, .gobi=getDefaultGGobi(), display = -1)
{
 if(mode(display) == "numeric") {
   display <- as.integer(display)
 } else if(inherits(display, "ggobiDisplay"))
      display <- display[["ref"]]

 plots <- list(...)
 n <- length(plots)

 if(n == 0)
    plots <- NULL
 else {
    plots <- lapply(plots, resolvePlotDescription, .data = .data, .gobi = .gobi)
 }

  # We can compute this if it is missing and cells is not.
 if(length(mfrow) == 0) {
   nrows <- n # ceiling(sqrt(n))
   ncols <- 1 # sqrt(n)
   mfrow <- c(nrows, ncols)
 }

 if(missing(cells))
   cells <- t(gtkCells(mfrow[1], mfrow[2]))
 else {
      # We'll transpose gtkCells for you.
    if(ncol(cells) == 4)
      cells <- t(cells)
 }

 if(mode(.data) == "numeric") {
   .data <- as.integer(.data -1)
 }

 if(mode(.gobi) == "numeric") {
   .gobi <- as.integer(.gobi -1)
 }

 val <- .Call(.ggobi.symbol("createPlots"), plots, as.integer(mfrow), as.integer(cells-1), .gobi, display, .data)

 gdk.flush()

 val
}

gtkCells <-
function(r, c)
{
 x <- rep(1:c, r)
 y <- rep(1:r, rep(c, r))
 l <- cbind(left = x, right = x+1, top = y, bottom = y+1)
 l
}
createDisplay.ggobi <-
function(type, vars, .data = 1, .gobi = getDefaultGGobi())
{
  if(!inherits(type, "GtkType")) {
    types <- getDisplayTypes.ggobi()
    id <- match(type, names(types))
    if(is.na(id)) {
      id <- match(type, sapply(d, names))
    }

    if(is.na(id))
      stop("Unrecognized plot type")

    type <- types[[id]]
  }

  if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)  

  .GGobiCall("createPlot", type, as.integer(vars), .data, .gobi = .gobi)
}  


scatterplot.ggobi <-
function(x, y, .data = 1, .gobi = getDefaultGGobi()) 
{
 if(missing(y) && length(x)  > 1) {
   y <- x[2]
   x <- x[1]
 }
    
  
  x <- getVariableIndex.ggobi(x, y, .data = .data, .gobi = .gobi) - 1

  if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)

 .GGobiCall("newScatterplot", as.integer(x), .data, .gobi = .gobi)
}

parcoords.ggobi <-
function(..., .data = 1, .gobi = getDefaultGGobi()) 
{
  x <- getVariableIndex.ggobi(..., .data=.data, .gobi = .gobi)

  if(length(x) == 0)
    stop("No variable specified in parcoords.ggobi")

  if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)

 .GGobiCall("newParcoords", as.integer(x-1), .data, .gobi = .gobi)
}


scatmat.ggobi <-
#
#
#
#
function(x, y, .data = 1, .gobi = getDefaultGGobi()) 
{
  if(!inherits(.data, "ggobiDataset")) {
    .data <- getDatasetReference.ggobi(.data, .gobi=.gobi)
  }

 if(missing(x)) {
   x <- as.integer(seq(1, length=ncol(.data)))
 }

 if(mode(x) != "numeric")
   x <- getVariableIndex.ggobi(x, .data = .data, .gobi = .gobi) 

 if(missing(y)) {
   y <- x
 } else {
  if(mode(y) != "numeric")	
    y <- getVariableIndex.ggobi(y, .data = .data, .gobi = .gobi)
 }

 if(any(is.na(x)) | any(is.na(y)))
   stop("No missing values allowed")


 .GGobiCall("newScatmat", as.integer(x-1), as.integer(y-1), .data, .gobi = .gobi)
}

getVariableIndex.ggobi <-
function(..., .data=1, .gobi = getDefaultGGobi())
{
 args <- list(...)
 if(length(args) < 1) {
   return(integer(0))
 }

 els <- getVariableNames.ggobi(.data=.data, .gobi = .gobi)

 ans <- integer(0)
 for(i in unlist(list(...))) {
   if(is.character(i))   
      ans <- c(ans,  match(i, els))
   else
      ans <- c(ans,  i)
 }

 return(ans)
}



setPlotVariables.ggobi <-
#
# In this version, one cannot alter the variables
# in a programmatically generated display that is
# embedded within another display's window.
#
function(..., display = 1, .gobi = getDefaultGGobi(), plots = NULL)
{
 if(is.numeric(display))
   display <- as.integer(display)

   # find out what type of plot we are dealing with.
   # won't work for hybrid types.
 type <- getPlotType.ggobi(display, .gobi = as.integer(.gobi))

   # Determine the number of splots within this display.
 if(missing(plots)) {
   numPlots <- getPlotCount.ggobi(display, .gobi)
   plots <- 1:numPlots
 } else {
   plots <- as.integer(plots)
   numPlots <- length(plots)
 }

   # We need the dataset associated with the display.
  data <- getDatasetReference.ggobi(display, .gobi = .gobi)
  varNames <- names(data)

   # Now, get the indices of the variables the user has specified.
 varIds <- as.integer(getVariableIndex.ggobi(..., .data = data, .gobi = .gobi) -1)

   # Since we are setting these for the individual sub-plots,
   # determine how we skip over the variables as we iterate
   # over the plots.
 offset <- switch(type,"scatterplot"=2, "parallel coordinates plot"=1,
                        "scatterplot matrix"=2) 


 
 olds <- vector("list", numPlots)
 for(i in 1:numPlots) {
   if(length(varIds) >= offset) {
     tmp <- as.integer(varIds[1:offset])
     olds[[i]] <- .GGobiCall("setPlotVariables", tmp, ifelse(is.integer(display),as.integer(display-1),display), as.integer(i-1), .gobi= .gobi)
  
       # Put names on these indices
     names(olds[[i]]) <- varNames[olds[[i]]]     
     varIds <- varIds[-c(1:offset)]
   }
  }

 .GGobiCall("updateDisplay", as.integer(display-1), .gobi=.gobi)
 return(olds)
}

getPlotType.ggobi <-
#
# This tells the type of plot(s) in a given display 
# window within a ggobi instance.
# 
function(display = 1, .gobi = getDefaultGGobi())
{
 .GGobiCall("getDisplayType",  as.integer(display-1), .gobi = .gobi)
}

getPlotCount.ggobi <-
# This tells the number of plots within  a given display 
# window within a ggobi instance.
function(display = 1, .gobi = getDefaultGGobi())
{
 .GGobiCall("getNumPlotsInDisplay",  as.integer(display-1), .gobi = .gobi)
}

getDisplayCount.ggobi <-
function(.gobi=getDefaultGGobi())
{
 .GGobiCall("getNumDisplays", .gobi=.gobi)
}

ggobi.setPrintHandler <-

# A very simple version of registering an S-specific print handler. In
# this case, we discard the dialog and register a handler that takes
# the global print options and `prints' the display. All it currently
# does by default is print the options and the display to the screen.

#
#
# The callbackHandler is for when the user clicks on the print menu.
#
# The optionsHandler is when (and if) the user clicks on the Okay
# button of the dialog. That may never happen if the callbackHandler
# does not use the default dialog.
#
# In either case, the callback can be specified as an S function
# which is to be called for that event, or a string which identifies
# a C routine which is to be used.
#
#
function(optionsHandler = function(dpy, opts){print(dpy); print(opts)},
         callbackHandler = NULL)
{
 .Call("RSggobi_setPrintHandler", callbackHandler, optionsHandler)
}

getRowNames.ggobi <-
function(.data = 1, .gobi = getDefaultGGobi()) 
{
  if(mode(.data) == "numeric")
    .data <- as.integer(.data-1)

 .GGobiCall("getRowNames", .data, .gobi = .gobi)
}


setRowNames.ggobi <-
function(names, ids = 1:length(names), .data = 1, .gobi = getDefaultGGobi())
{
 if(mode(.data) == "numeric")
    .data <- as.integer(.data-1)

 ids <- as.integer(ids -1)

 .GGobiCall("setRowNames", as.character(names), ids, .data, .gobi = .gobi)
}

getRowGroups.ggobi <-
function(.data = 1, .gobi = getDefaultGGobi())
{
 if(mode(.data) == "numeric")
    .data <- as.integer(.data-1)

 .GGobiCall("getRgroups", .data = .data, .gobi = .gobi)
}


setRowGroups.ggobi <-
function(ids, .data = 1,  .gobi = getDefaultGGobi())
{
 if(mode(.data) == "numeric")
    .data <- as.integer(.data-1)

 old <- getRowGroups(.data, .gobi = .gobi)

 .GGobiCall("setRgroups", as.integer(ids), .data = .data,  .gobi = .gobi)

 old
}
if(FALSE) {
setGlyphs.ggobi <-
#
# Sets the glyph type and/or size for 
# one or more rows/observations of the specified
# ggobi instance.
function(ids, type = rep(-1,length(ids)), size = rep(-1, length(ids)), .data = 1, .gobi = getDefaultGGobi())
{
 if(missing(type) & missing(size))
  stop("Must specify either or both type and size")

 if(!is.integer(type)) {
   type <- mapGlyphType(type)
 }

 k <- max(length(ids),length(type), length(size))
 ids <- rep(as.integer(ids), length=k)
 type <- rep(as.integer(type), length=k)
 size <- rep(as.integer(size), length=k)

 size  <- as.integer(size)

 if(!is.integer(ids)) {
   ids <- mapRowIds(ids, .gobi = .gobi)
 }

  if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)

 .GGobiCall("setCaseGlyphs", type, size, ids, .data, .gobi = .gobi)
}
}

setVariableNames.ggobi <-
#
# the arguments must be named
# and the name of the argument should identify
# the existing variable. The value of the argument
# is used as the new name.
#
function(..., .data = 1, .gobi=getDefaultGGobi())
{
  args <- c(...)
  ids <- as.integer(getVariableIndex.ggobi(names(args), .gobi=.gobi) - 1)
  

   # get rid of those that didn't match.
  if(any(is.na(ids))) {
    warning(paste("some names did not match the existing names: ", paste(names(args)[is.na(ids)], collapse=", ")))
    which <- !is.na(ids)
    args <- args[which]
    ids <- ids[which]
  }

  if(mode(.data) == "numeric")
    .data <- as.integer(.data - 1)

  .GGobiCall("setVariableNames", ids, as.character(args), .data, .gobi = .gobi)
}
setVariableValues.ggobi <-
function(values, var, rows = 1:length(values), update = T, .data = 1, .gobi = getDefaultGGobi())
{
 if(missing(var)) {
  values <- as.data.frame(values)
  var <- names(values)
 }


  # Get the indices for the variable(s) to be changed.
 varId <- as.integer(getVariableIndex.ggobi(var) - 1)

 if(mode(.data) == "numeric")
   .data <- as.integer(.data - 1)

.GGobiCall("setVariableValues", as.numeric(values), as.integer(rows-1), varId, as.logical(update), .data, .gobi=.gobi)
}
addVariable.ggobi <-
function(vals, name, .data = 1, .gobi = getDefaultGGobi())
{
 if(mode(.data) == "numeric")
   .data <- as.integer(.data - 1)

 .GGobiCall("addVariable", as.numeric(vals), as.character(name), .data, .gobi=.gobi)
}


removeVariable.ggobi <-
function(..., .data = 1, .gobi = getDefaultGGobi())
{
 which <- getVariableIndex.ggobi(..., .gobi=.gobi)

 .GGobiC("removeVariables", which, .data, .gobi = .gobi)[[1]]
}



getVersion.ggobi <-
function()
{
  info <- .Call(.ggobi.symbol("getVersionInfo"))

  names(info) <- c("date", "version", "version string")
  names(info$version) <- c("major", "minor", "patch")
 info
}
#
# This can be used to write out an XML description of one or more
# data frames into GGobi's data format.
#


  # Could use another output tree mechanism such as xmlTree(), xmlOutputBuffer(), etc.
  # e.g.
  #  dom <- xmlTree("ggobidata", attrs = c(count = length(args)))

writeDataXML <-
function(..., dom = xmlOutputDOM("ggobidata", attrs = c(count = length(args))))  
{
  args <- list(...)

  for(i in 1:length(args)) {
    name <- names(args)[i]
    # if this is "", use the deparse() version
    addXMLDataset(args[[i]], name, dom)
  }

  dom
}  

addXMLDataset <-
function(data, name, dom, description = NULL, asElements = TRUE)
{

  dom$addTag("data", attrs=c(name=name), close = FALSE)
  dom$addTag("description", description)

  dom$addTag("variables", attrs=c(count = ncol(data)), close=FALSE)
  for(i in names(data)) {
    if(inherits(data[[i]], "factor")) {
      dom$addTag("categorical", attrs = c(name = i), close = FALSE)
        levs <- levels(data[[i]])
        dom$addTag("levels", attrs = c(count=length(levs)), close = FALSE)
        for(j in 1:length(levs)) {
           dom$addTag("level", levs[j], attrs= c(value=j))
        }
      dom$closeTag("levels")
      dom$closeTag("categorical")
    } else
      dom$addTag("realvariable", attrs = c(name = i))
  }

  dom$addTag("records", attrs =c(count = nrow(data)), close = FALSE)

  rownames <- dimnames(data)[[1]]
  for(i in 1:nrow(data)) {
      # If we want to put <el>value</el><el>value</el> within the <record>
      # we'll have to do it one at a time!
   if(asElements) {
     dom$addTag("record", close = FALSE)
     for(r in data[i,]) {
        tag <- switch(typeof(r), double="real", integer="int")
        dom$addTag(tag, r)
     }
     dom$closeTag("record")
   } else
     dom$addTag("record", paste(data[i,], collapse=" "), attrs = c(label = rownames[i]), close = TRUE)
  }
  dom$closeTag("records")
  
  dom$closeTag("data")
}  
#
# Read color schemes from an XML file.
#

readXMLColorSchemes <-
function(uri, handlers = xmlColorSchemeHandlers())
{
  require(XML)
  xmlTreeParse(uri, handlers = handlers)
  handlers$getData()
}  

xmlColorSchemeHandlers <-
function()
{
 schemes <- list()


 getColor <-
   function(x) {
     # Handle the max and min here also!
             vals <- list()
             xmlSApply(x, function(z) {
                vals[[xmlName(z)]] <<- as.numeric(xmlValue(z[[1]]))
              })

             mx <- max(c(unlist(vals), 1.0))
             ats <- xmlAttrs(x)
             if("max" %in% names(ats)) {
               vals$max <- mx <- as.numeric(ats[["max"]])
             } else {
               if(mx > 1.0)
                 warning(paste("RGB value", mx, "greater than 1."))
             }


             
             vals$value <- rgb(vals$red/mx, vals$green/mx, vals$blue/mx)
             vals
           }

 colormap <- function(node, ...) {
  at <- xmlAttrs(node)

  scheme <- list()
  desc <- node[["description"]]
  if(!is.null(desc))
    scheme$description <- xmlValue(desc)


  scheme$colors <- xmlApply(node[["foreground"]],  getColor)
  names(scheme$colors) <- xmlSApply(node[["foreground"]],
                                    function(x) {
                                       at <- xmlAttrs(x)
                                       ifelse("name" %in% names(at), at[["name"]], "")
                                       })

  for(i in c("background", "annotations")) {
    scheme[[i]] <- getColor(node[[i]][[1]])  
  }

  type <- paste(at[["type"]], "ColorScheme", sep="")

  class(scheme) <- c(type, "ColorScheme")
  schemes[[at[["name"]]]] <<- scheme
  NULL
 }

 list(colormap = colormap, getData = function() schemes)
}  
dataDescriptionHandlers <-
function()
{
  Data <- list()
  class(Data) <- "XMLDataCollectionInfo"

  count <- 0

  data <- function(node, ...) {
    d <- list()
    
    d[["description"]] <- xmlValue(node[["description"]])
    d[["variables"]] <- node[["variables"]]
    

    d[["count"]] <- count
    count <<- 0

    class(d) <- "DatasetInfo"
    name <- xmlAttrs(node)[["name"]]    
    Data[[name]] <<- d    
    
    NULL
  }


  realvariable <-
    function(node, ...) {
       var <- realvariableInfo(node)

       var
    }
  
  variables <- function(node, ...) {
    els <- xmlChildren(node)
    names(els) <- sapply(els, function(x) x$name)
    els
  }

  
  variable <- function(node, ..) {
     xmlAttrs(node)[["name"]]     
  }

 catvariable <- function(node, ...) {
   l <- xmlApply(node[["levels"]],
                 function(x) {
                   idx <- as.integer(xmlAttrs(x)[["value"]])
                   label <- xmlValue(x)
                   ans <- c(label)
                   names(ans) <- idx
                   ans
                 })
   names(l) <- rep(node[["name"]], length(l))
   l
 }

 
  
  list(data = data,
       variables = variables,
       realvariable = realVariableInfo.XMLNode,
       categoricalvariable = categoricalVariableInfo.XMLNode,
       records = function(x, ...) NULL,
       record = function(x, ...) { count <<- count + 1; NULL},
       Data = function() Data)
}


realVariableInfo <-
function(x, ...)
{
 UseMethod("realVariableInfo")
}

categoricalVariableInfo <-
function(x, ...)
{
 UseMethod("realVariableInfo")
}

variableInfo <-
function(x, ...)
{
 UseMethod("variableInfo")
}  

realVariableInfo.XMLNode <-
function(x, ..., numericFields = c("min", "max"))
{
       at <- xmlAttrs(x)
       var <- variableInfo(x, ..., className = "RealVariableInfo")
       for(i in numericFields) {
         var[[i]] <-  ifelse(i %in% names(at), as.numeric(at[[i]]), NA)         
       }

       var
}


categoricalVariableInfo.XMLNode <-
function(x, ..., numericFields = c("min", "max"))
{
       var <- variableInfo(x, ..., className = "CategoricalVariableInfo")

       var$levels <- xmlSApply(x[["levels"]], function(x) as.integer(xmlAttrs(x)[["value"]]))
       
       names(var$levels) <- xmlApply(x[["levels"]], function(x) xmlValue(x))

       var
}


variableInfo.XMLNode <-
function(x, ..., className = NULL)
{  
       var <- list()

       at <- xmlAttrs(x)       

       var$name <- at[["name"]]
       for(i in c("nickname")) {
         var[[i]] <-  ifelse(i %in% names(at), at[[i]], "")         
       }
      
       var$description <- x[["description"]]
       var$quickHelp <- x[["quickHelp"]]       

       class(var) <- c(className, "VariableInfo")

       var
}
xmlDataViewer <-
function(fileName = "~/Projects/ggobi/ggobi/data/eies.xml", callback = function(obj, w){ guiShow(obj)})
{
 info <- xmlTreeParse(fileName, handlers = dataDescriptionHandlers())$Data()

 tr <- xmlDataTreeViewer(info, name = fileName, callback = callback)

 sw <- gtkScrolledWindow()
 sw$AddWithViewport(tr)

 win <- gtkWindow()
 win$Add(sw)
 
 win$SetUsize(300, 300)

 list(win = win, tr = tr)
}

xmlDataTreeViewer <-
function(info, name = "", top = gtkTree(), callback = function(obj, w){ guiShow(obj)})
{
  UseMethod("xmlDataTreeViewer")
}  

xmlDataTreeViewer.XMLDataCollectionInfo <-
function(info, name = "", top = gtkTree(), callback = function(obj, w){ guiShow(obj)})  
{
  item <- gtkTreeItem(name)
  top$Append(item)

  tr <- gtkTree()
  for(i in names(info)) {
    it <- gtkTreeItem(i)
    if(!is.null(callback))
      it$AddCallback("select", callback, info[[i]])
    tr$Append(it)    
    tmp <- xmlDataTreeViewer(info[[i]], name = i, callback = callback)
    it$SetSubtree(tmp)
  }

  item$SetSubtree(tr)

  top
}  

xmlDataTreeViewer.DatasetInfo <-
function(info, name = "", top = gtkTree(), callback = function(obj, w){ guiShow(obj)})  
{
  item <- gtkTreeItem("Description")
  item$AddCallback("select", callback, list(info, "description", info))
  top$Append(item)

  item <- gtkTreeItem("Variables")
  top$Append(item)
  tr <- gtkTree()
  for(i in names(info[["variables"]])) {
    it <- gtkTreeItem(i)
    if(!is.null(callback))
      it$AddCallback("select", callback, list(info[[i]], i, info))
    tr$Append(it)
    tmp <- xmlDataTreeViewer(info[["variables"]][[i]], name = i, callback = callback)
    it$SetSubtree(tmp)
  }
  item$SetSubtree(tr)

  top
}  

xmlDataTreeViewer.VariableInfo <-
function(info, name = "", top = gtkTree())  
{
  fields <- getSimpleTreeSlots(info)

  which <- match(fields, names(info))
  for(i in fields[!is.na(which)]) {
    item <- gtkTreeItem(i)
    top$Append(item)

    if(!is.null(callback))
      it$AddCallback("select", callback, list(info[[i]], i, info))    
  }

  top
}

getSimpleTreeSlots <-
function(obj)
{
  UseMethod("getSimpleTreeSlots")
}

getSimpleTreeSlots.VariableInfo <-
function(obj)
{
   c("name", "nickname", "description", "quickHelp")
}

getSimpleTreeSlots.RealVariableInfo <-
function(obj)
{
  names(obj)
}  

getSimpleTreeSlots.CategoricalVariableInfo <-
function(obj)
{
  names(obj)[- match("levels", names(obj))]
}  


xmlDataTreeViewer.CategoricalVariableInfo <-
function(info, name = "", top = gtkTree())
{
  top <- xmlDataTreeViewer.VariableInfo(info, name = name, top = top)
  item <- gtkTreeItem("levels")
  top$Append(item)
  tr <- gtkTree()
  for(i in names(info$levels)) {
     it <- gtkTreeItem(i)
     tr$Append(it)
  }
  item$SetSubtree(tr)

  top
}  
  
guiShow <-
function(obj, container = gtkVBox())
{
 UseMethod("guiShow")
}

guiShow.default <-
function(obj, container = gtkVBox())
{
  NULL
}  

guiShow.VariableInfo <-
function(obj, container = gtkVBox())
{
  slots <- getSimpleTreeSlots(obj)

  for(i in slots) {
    b <- gtkHBox(TRUE, 3)
    label <- gtkLabel(i)
    b$PackStart(label)
    val <- gtkLabel(info[[i]])
    b$PackStart(val)    
    container$PackStart(b)
  }
}  


# Create two functions that share
# the same environment and specifically
# a variable that identifies the currently 
# active GGobi.


init.ggobi <-
function(args)
{
 .Call(.ggobi.symbol("init"), as.character(args), FALSE)
}  

tmp <- (function() {
 n <- NULL

getDefaultGGobi <-
function()
{
 return(n)
}

setCurrentGGobi<-function(which)
{
 if(is.integer(which) || is.numeric(which)) {
   n <<- getGGobi(as.integer(which)[1])[[1]]
 } else
   n <<- which
}

 return(list(getDefaultGGobi, setCurrentGGobi))

})()

getDefaultGGobi <- tmp[[1]]
setDefaultGGobi <- tmp[[2]]
rm(tmp)


.First.lib <-
function(libname, pkgname) {
   library.dynam("Rggobi", pkgname, libname)

   checkStructs.ggobi()

   e <- new.env()
   assign("n", NULL, envir=e)    
   environment(getDefaultGGobi) <<- e
   environment(setDefaultGGobi) <<- e
}
