cside: Compound Specific Isotope Data Explorer

#' @include utils.R

# Generic functions that Gui classes can attach to

# convenience for interacting with the module
setGeneric("getModule", function(gui, module, id) standardGeneric("getModule")) # enables multi-module interfaces
setGeneric("getElements", function(gui, module, ids) standardGeneric("getElements"))
setGeneric("setElements", function(gui, module, ...) standardGeneric("setElements"))
setGeneric("getWidgets", function(gui, module, ids) standardGeneric("getWidgets"))
setGeneric("setWidgets", function(gui, module, ...) standardGeneric("setWidgets"))
setGeneric("getSettings", function(gui, module, ids) standardGeneric("getSettings"))
setGeneric("setSettings", function(gui, module, ...) standardGeneric("setSettings"))
setGeneric("getData", function(gui, module, ids) standardGeneric("getData"))
setGeneric("setData", function(gui, module, ...) standardGeneric("setData"))

# making the gui
setGeneric("makeGui", function(gui, module) standardGeneric("makeGui"))
setGeneric("destroyGui", function(gui, module) standardGeneric("destroyGui"))
setGeneric("showGui", function(gui, module) standardGeneric("showGui"))
setGeneric("hideGui", function(gui, module) standardGeneric("hideGui"))
setGeneric("remakeGui", function(gui, module, show = TRUE) standardGeneric("remakeGui"))

# specific functions streamlining Gui design but that are not intended to be derived
setGeneric("getNavigationXML", function(gui, module) standardGeneric("getNavigationXML"))
setGeneric("makeNavigation", function(gui, module) standardGeneric("makeNavigation"))
setGeneric("makeInfoBar", function(gui, module) standardGeneric("makeInfoBar"))

# getting and setting key widgets
setGeneric("getWindow", function(gui, module) standardGeneric("getWindow"))
setGeneric("getWinGroup", function(gui, module) standardGeneric("getWinGroup"))
setGeneric("setMenuGroup", function(gui, module, menuGroup) standardGeneric("setMenuGroup"))
setGeneric("setToolbarGroup", function(gui, module, toolbarGroup) standardGeneric("setToolbarGroup"))

# functions that are intended to be extended in Gui derived classes
setGeneric("getMenuXML", function(gui, module) standardGeneric("getMenuXML"))
setGeneric("getToolbarXML", function(gui, module) standardGeneric("getToolbarXML"))
setGeneric("makeMainGui", function(gui, module) standardGeneric("makeMainGui"))
setGeneric("setNavigationActions", function(gui, module, actionGrp) standardGeneric("setNavigationActions"))

# other utility functions for interacting with the Gui

#' show an info message
#' type - styling of the mssage, info, error, question, warning are the standard ones
#' timer - time in seconds until message disappears automatically
#' okButton - whether there is an ok button or not
#' @method showInfo
setGeneric("showInfo", function(gui, module, msg, type="question", timer=2, okButton=TRUE) standardGeneric("showInfo"))
setGeneric("hideInfo", function(gui, module) standardGeneric("hideInfo"))

#########
# Class #
#########

# S4 class Gui
Gui <- setClass("BaseGui", representation = list(module="character")) 
                # module = which module this belongs to, is automatically set by the module

setMethod("initialize", "BaseGui", function(.Object, ...) {
  callNextMethod(.Object, ...)
})

###################
# general Methods #
###################

setMethod("makeGui", "BaseGui", function(gui, module) {
  dmsg("I am a ", class(gui), " with module ID '", gui@module, "' and I am making my Gui.")
  options("guiToolkit"="RGtk2") # everything is written in RGtk2
  
  # make window
  if (getSettings(gui, module, 'windowModal')) {
    dmsg("\tStarting MODAL window.")
    win <- gbasicdialog(
      title=getSettings(gui, module, "windowTitle"), do.buttons=FALSE) #FIXME add parent = 
    size(win) <- c(getSettings(gui, module, "windowSize")[1], getSettings(gui, module, "windowSize")[2])
  } else {
    dmsg("\tStarting non-modal window.")
    win <- gwindow(
      getSettings(gui, module, "windowTitle"), visible=FALSE, 
      width=getSettings(gui, module, "windowSize")[1], 
      height=getSettings(gui, module, "windowSize")[2])
  }
  
  # attach Gui load event to focus handler to enable modal dialog loading
  visHandler <- addHandlerFocus(win, handler=function(...) {
    dmsg("\tLoading Gui...")
    getModule(gui, module)$loadGui()
    blockHandler(win, ID=visHandler)
  })
  
  # destroy window properly
  addHandlerDestroy(win, function(h,...) getModule(gui, module)$destroyGui()) # clean all widgets
  
  # save window in module
  setWidgets(gui, module, window = win)
  
  # top window group
  baseGroup <- ggroup(horizontal=FALSE, expand=TRUE, cont = win, spacing=0) # contains only the winGroup and the infobar
  if (getSettings(gui, module, 'windowModal'))
    parent <- getToolkitWidget(baseGroup) # get automatic toplevel gtkHBox generated by dialog
  else
    parent <- getToolkitWidget(baseGroup)$getParent() # get automatic toplevel gtkHBox generated by gwindow
  parent['border-width']<-0 # remove border
  setWidgets(gui, module, 
    baseGroup = baseGroup,
    winGroup = ggroup(horizontal=FALSE, expand=TRUE, cont = baseGroup, spacing=0))
  
  # make info bar
  makeInfoBar(gui, module)
  
  # main make Gui
  makeMainGui(gui, module)
  makeNavigation(gui, module)
})

setMethod("destroyGui", "BaseGui", function(gui, module) {
  dmsg("I am a ", class(gui), " with module ID '", gui@module, "' and I am destroying my Gui.")
  dispose(getWindow(gui, module)) # destroy window
  getModule(gui, module)$destroyGui() # clean all widget references
})

setMethod("remakeGui", "BaseGui", function(gui, module, show = TRUE) {
  destroyGui(gui, module)
  makeGui(gui, module)
  if (show)
    showGui(gui, module)
})

setMethod("showGui", "BaseGui", function(gui, module) {
  if (is.null(getWindow(gui, module)))
    makeGui(gui, module)
  dmsg("I am a ", class(gui), " with module ID '", gui@module, "' and I am showing my Gui now.")
  visible(getWindow(gui, module), TRUE)
})

setMethod("hideGui", "BaseGui", function(gui, module) {
  dmsg("I am a ", class(gui), " with module ID '", gui@module, "' and I am hiding my Gui.")
  if (!is.null(getWindow(gui, module)))
    visible(getWindow(gui, module), FALSE)
})

################################
# methods for streamlining Gui #
################################

setMethod("getNavigationXML", "BaseGui", function(gui, module) {
  return(paste(
    '<ui>',
      '<menubar name="menubar">',
        getMenuXML(gui, module),      
      '</menubar>',
      '<toolbar name ="toolbar">',
        getToolbarXML(gui, module),
      '</toolbar>',
    '</ui>', sep="\n"))
})

setMethod("makeNavigation", "BaseGui", function(gui, module) {
  
  # navigation actions
  dmsg("\tInitializing Navigation.")
  setWidgets(gui, module, actionGroup = gtkActionGroup ("FileGroup"))
  dmsg("\tSetting Navigation Actions.")
  setNavigationActions(gui, module, getWidgets(gui, module, 'actionGroup'))
  
  # UI manager for navigation
  dmsg("\tMaking Navigation Manager.")
  uimanager <- gtkUIManagerNew() # ui manager
  uimanager$insertActionGroup (getWidgets(gui, module, 'actionGroup'), 0) # add actions
  uimanager$addUiFromString (getNavigationXML(gui, module)) # add ui 
  
  # menu
  menuGrp <- getWidgets(gui, module, 'menuGroup')
  if (!is.null(menuGrp)) {
    dmsg("\tMaking Menubar.")
    getToolkitWidget(menuGrp)$packStart (uimanager$getWidget ("/menubar"), FALSE ) # add menu
  }
    
  # toolbar
  toolbarGrp <- getWidgets(gui, module, 'toolbarGroup')
  if (!is.null(toolbarGrp)) {
    getToolkitWidget(toolbarGrp)$packStart (uimanager$getWidget ( "/toolbar" ), TRUE) # add toolbar
    dmsg("\tMaking Toolbar.")
  }
  getToolkitWidget(getWindow(gui, module))$addAccelGroup (uimanager$getAccelGroup()) # add keyboard triggers
  
  return(uimanager)
})

setMethod("makeInfoBar", "BaseGui", function(gui, module){
  infoBar <- gtkInfoBar (show=FALSE) 
  infoBar$setNoShowAll(TRUE)
  infoLabel <- gtkLabel ( "Warning , Warning")
  infoLabel$setLineWrap(TRUE)
  infoBar$setMessageType("question") 
  infoBar$getContentArea()$add(infoLabel)
  infoOkButton <- infoBar$addButton(button.text = "gtk-ok", response.id = GtkResponseType['ok'])
  gSignalConnect(infoBar, "response", function(infoBar, resp.id) hideInfo(gui, module))
  getToolkitWidget(getWidgets(gui, module, "baseGroup"))$packStart(infoBar, expand=FALSE)
  setWidgets(gui, module, infoBar = infoBar, infoLabel = infoLabel, infoOkButton = infoOkButton)
})


setMethod("showInfo", "BaseGui", function(gui, module, msg, type="question", timer=2, okButton=TRUE) {
  dmsg("\tShowing info message for ", timer, " seconds.")
  getWidgets(gui, module, 'infoBar')$setMessageType(type)
  getWidgets(gui, module, 'infoLabel')$setText(msg)
  getWidgets(gui, module, 'infoBar')$show()
  if (!okButton)
    getWidgets(gui, module, 'infoOkButton')$hide()  
  else
    getWidgets(gui, module, 'infoOkButton')$show()
  if (!is.null(timer)) {
    Sys.sleep(timer)
    hideInfo(gui, module)
   }
})

# hide info bar
setMethod("hideInfo", "BaseGui", function(gui, module) {
  dmsg("\tHiding info message.")
  getWidgets(gui, module, 'infoBar')$hide()
})


############################################
# methods that are supposed to be extended #
############################################

setMethod("getMenuXML", "BaseGui", function(gui, module) { return('') })

setMethod("getToolbarXML", "BaseGui", function(gui, module) { return('') })

setMethod("makeMainGui", "BaseGui", function(gui, module) {})

setMethod("setNavigationActions", "BaseGui", function(gui, module, actionGrp) { })

######################################################
# Convenience functions for interacting with the module #
######################################################

setMethod("getModule", "BaseGui", function(gui, module) {
  return(module$getModule(gui@module))
})

setMethod("getElements", "BaseGui", function(gui, module, ids) {
  return(getModule(gui, module)$getElements(ids))
})

setMethod("setElements", "BaseGui", function(gui, module, ...) {
  return(getModule(gui, module)$setElements(...))
})

setMethod("getWidgets", "BaseGui", function(gui, module, ids) {
  return(getModule(gui, module)$getWidgets(ids))
})

setMethod("setWidgets", "BaseGui", function(gui, module, ...) {
  return(getModule(gui, module)$setWidgets(...))
})

setMethod("getSettings", "BaseGui", function(gui, module, ids) {
  return(getModule(gui, module)$getSettings(ids))
})

setMethod("setSettings", "BaseGui", function(gui, module, ...) {
  return(getModule(gui, module)$setSettings(...))
})

setMethod("getData", "BaseGui", function(gui, module, ids) {
  return(getModule(gui, module)$getData(ids))
})

setMethod("setData", "BaseGui", function(gui, module, ...) {
  return(getModule(gui, module)$setData(...))
})

###################################
# Getting and Setting key widgets #
###################################

setMethod("getWindow", "BaseGui", function(gui, module) {
  return(getWidgets(gui, module, "window"))
})

setMethod("getWinGroup", "BaseGui", function(gui, module) {
  return(getWidgets(gui, module, "winGroup"))
})

setMethod("setMenuGroup", "BaseGui", function(gui, module, menuGroup) {
  setWidgets(gui, module, menuGroup = menuGroup)
})

setMethod("setToolbarGroup", "BaseGui", function(gui, module, toolbarGroup) {
  setWidgets(gui, module, toolbarGroup = toolbarGroup)
})