Nothing
# General GUI functionality and utilities
########################## The core GUI #########################
getMainWindow <- function() .exp$getMainWindow()
MnuExit_cb <- function(w, event, should_quit = F)
{
exp_close()
if (should_quit)
quit("no")
}
####################### GtkTreeView utilities ########################
# gets the values in cols for selected rows in a TreeView
getSelectedData <-
function(treeView, cols = seq_len(treeView$getModel()$getNColumns()))
{
model <- treeView$getModel()
treesel <- treeView$getSelection()
rows <- treesel$getSelectedRows()$retval
if (length(rows) > 0) {
model[rows, cols]
} else NULL
}
# adds a set of text columns to 'view' with 'colnames' using 'cols' from the view's model
# the columns are inserted at the position specified by 'insert'
# if 'editors' are specified, the columns are editable and 'edit_starters' if specified
# are called when editing begins while 'editors' are called after editing has finished.
# The user data for the callbacks is given as 'data'
# If 'combo' is TRUE, combobox renderers are used instead of simple text renderers
textColumnsToView <- function(treeView, col_names,
cols=match(col_names, colnames(treeView$getModel()))-1, insert = -1,
width = rep(120, length(col_names)), editors, edit_starters,
user_data = treeView$getModel(), combo = F) {
if (length(col_names) == 0)
return()
columns <- NULL
for (i in 1:length(col_names)) {
if (combo) {
renderer <- gtkCellRendererCombo()
renderer$set(model = rGtkDataFrame(empty_data_frame("character")),
text_column = 0, has_entry = F)
} else renderer <- gtkCellRendererText()
renderer$setData("model", treeView$getModel())
if (!missing(editors) && !is.null(editors[[i]])) {
renderer$set(editable = T)
gSignalConnect(renderer, "edited", editors[[i]], user_data)
if (!missing(edit_starters) && !is.null(edit_starters[[i]]))
gSignalConnect(renderer, "editing-started", edit_starters[[i]], user_data)
}
column <- gtkTreeViewColumn(col_names[i], renderer, text = cols[i])
column$setSizing("fixed")
column$setFixedWidth(width[i])
treeView$insertColumn(column, insert)
columns <- c(columns, column)
}
columns
}
rootModel <- function(treeView) {
model <- treeView$getModel()
while(!inherits(model, "RGtkDataFrame"))
model <- model$getModel()
model
}
# this configures all columns for 'view' using 'cols' as the sort id's.
configureViewColumns <- function(treeView, cols)
{
columns <- treeView$getColumns()
if (missing(cols)) {
titles <- sapply(columns, gtkTreeViewColumnGetTitle)
cols <- match(titles, colnames(treeView$getModel()))
}
for (i in 1:length(cols)) {
configureViewColumn(columns[[i]], cols[i])
}
}
# configures a view column so that it is reorderable, resizable, and
# sorted on 'sort_col' as long as 'sort_col' != -1
# if 'removable' is TRUE, this column is considered temporary
# 'keyword' will link columns to the context-sensitive help
configureViewColumn <- function(column, sort_col = -1, removable = T,
desc = column$getTitle(), keyword = desc) {
column$setReorderable(TRUE)
column$setResizable(TRUE)
column$setData("keyword", keyword)
column$setData("removable", removable)
# serious GtkTreeView wizardry follows
label <- gtkLabel(column$getTitle())
label$setEllipsize("end")
label["xalign"] <- 0
column$setWidget(label)
alignment <- label$getParent()
alignment["xscale"] <- 1
gSignalConnect(alignment, "notify::xscale", function(alignment, pspec)
{
if (alignment["xscale"] != 1)
alignment["xscale"] <- 1
})
button <- alignment$getParent()$getParent()
.exp$getTooltips()$setTip(button, desc, keyword)
# wizardry concluded
if (sort_col != -1) {
column$setSortColumnId(sort_col-1)
}
}
scrollView <- function(treeView)
{
scroll <- gtkScrolledWindow(NULL, NULL)
scroll$setPolicy("automatic", "automatic")
scroll$add(treeView)
scroll
}
viewColumnWidth_cb <- function(column, pspec) {
w <- column$getWidth()
if (w > 150 && !(column$getSizing() == "fixed")) {
w <- 150
column$setSizing("fixed")
column$setFixedWidth(w)
}
}
######################## Showing Results ###########################
# Show analysis results
# Add a column of analysis results to the exploRase table and the GGobi dataset.
#
# @arguments the data frame of results. To include results for multiple
# entity types at once, the result for each type should be concatenated in the
# same order as the \code{types} parameter.
# @arguments a root label for the result (like the type of analysis)
# @arguments other labels concatenated to the root (such as the conditions involved)
# @arguments the entity type(s) of the data from which this result was derived.
# @arguments a keyword identifying this result, for use in context-sensitive help
# @arguments whether to show the result in the explorase table
# @arguments whether to add the result to the GGobi dataset
# @keyword GUI
# @keyword manip
exp_showResults <- function(results, label, sublabels = "", types = exp_entityType(),
keyword = NULL, explorase = T, ggobi = T)
{
printOp("Showing results")
results_name <- createVarName(sublabels, label)
if (explorase) {
addResultColumn(results, results_name, types, keyword)
}
if (ggobi) {
addGGobiVariable(results, results_name, types)
}
}
################### Dialog utilities ##########################
errorDialog <- function(..., parent = getMainWindow())
{
dialog <- gtkMessageDialog(parent, "destroy-with-parent", "error", "close", ...)
gSignalConnect(dialog, "response", gtkWidgetDestroy)
}
warningDialog <- function(..., parent = getMainWindow())
{
dialog <- gtkMessageDialog(parent, "destroy-with-parent", "warning", "close", ...)
gSignalConnect(dialog, "response", gtkWidgetDestroy)
}
###################### Misc utilities #######################
columnBoxRowSeparator_func <- function(model, iter, data)
{
if (model$get(iter, 0) == "")
return(T)
return(F)
}
# get an action (GtkAction) in the user interface by name
getAction <- function(name)
{
groups <- .exp$getUIManager()$getActionGroups()
group_names <- sapply(groups, gtkActionGroupGetName)
groups[[which(group_names == "exploRaseActions")]]$getAction(name)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.