#' @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)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.