Nothing
# appWindow demo from GTK
window <- NULL
# define some callbacks
activate.radio.action <- function(action, current)
{
name <- action$getName()
typename <- class(action)[1]
value <- current$getCurrentValue()
if (current$getActive()) {
text <- sprintf("You activated radio action: \"%s\" of type \"%s\".\nCurrent value: %d", name, typename, value)
messagelabel$setText(text)
infobar$setMessageType(value)
infobar$show()
}
}
activate.action <- function(action, w)
{
name <- action$getName()
typename <- class(action)[1] # parent, dialog mode, message type, buttons, message
dialog <- gtkMessageDialogNew(window, "destroy-with-parent", "info", "close",
"You activated action:", name, "of type", typename)
gSignalConnect(dialog, "response", gtkWidgetDestroy)
}
activate.email <- function(about, link, data)
{
print(paste("send mail to", link))
}
activate.url <- function(about, link, data)
{
print(paste("show url", link))
}
about.cb <- function(action, window)
{
filename <- imagefile("rgtk-logo.gif")
if (file.exists(filename)) {
pixbuf <- gdkPixbufNewFromFile(filename)[[1]]
# make white space transparent
transparent <- pixbuf$addAlpha(TRUE, 253, 253, 253)
}
gtkAboutDialogSetEmailHook(activate.email)
gtkAboutDialogSetUrlHook(activate.url)
gtkShowAboutDialog(window, program_name="RGtk Example", version="2.0",
copyright="(C) M. Lawrence and D. Temple Lang",
license="GPL",
website="http://www.omegahat.net/RGtk",
comments="An example of RGtk2",
authors=c("Michael <mflawren@fhcrc.org>", "Duncan"),
documenters="See authors", logo=transparent)
}
update.statusbar <- function(buffer, statusbar)
{
statusbar$pop(0)
count <- buffer$getCharCount()
# get an "iter" describing the position of the cursor
mark <- buffer$getInsert()
iter <- buffer$getIterAtMark(mark)$iter
row <- iter$getLine()
col <- iter$getLineOffset()
msg <- paste("Cursor at row", row, "column", col, "-", count, "chars in document")
statusbar$push(0, msg)
}
mark.set.callback <- function(buffer, new.location, mark, data)
{
update.statusbar(buffer, data)
}
update.resize.grip <- function(widget, event, statusbar)
{
max_full_mask <- GdkWindowState["maximized"] | GdkWindowState["fullscreen"]
if (event[["changedMask"]] & max_full_mask)
{
statusbar$setHasResizeGrip(!(event[["newWindowState"]] & max_full_mask))
}
return(FALSE)
}
registered <- FALSE
register.stock.icons <- function()
{
if (registered)
return
item <- list(c("rgtk-logo", "_RGtk!", 0, 0, NULL))
gtkStockAdd(item) # register as stock
# now we also have to add it to an icon factory
factory <- gtkIconFactoryNew() # make our own factory
gtkIconFactoryAddDefault(factory) # make it a default factory
filename <- imagefile("rgtk-logo.gif")
if (file.exists(filename)) {
pixbuf <- gdkPixbufNewFromFile(filename)[[1]]
# make white space transparent
transparent <- pixbuf$addAlpha(TRUE, 255, 255, 255)
# make an icon from the image and add it to factory using stock id
icon.set <- gtkIconSetNewFromPixbuf(transparent)
factory$add("rgtk-logo", icon.set)
} else warning("Could not load the RGtk logo")
registered = TRUE
}
# create the actions
entries <- list(
# name, stock.id (prefab icons), label (. signifies mneumonic)
list("FileMenu", NULL, "_File"),
list("PreferencesMenu", NULL, "_Preferences"),
list("ColorMenu", NULL, "_Color"),
list("ShapeMenu", NULL, "_Shape"),
list("HelpMenu", NULL, "_Help"), # accelerator (kb shortcut), tooltip, callback
list("New", "gtk-new", "_New", "<control>N", "Create a new file", activate.action),
list("Open", "gtk-open", "_Open", "<control>O", "Open a file", activate.action),
list("Save", "gtk-save", "_Save", "<control>S", "Save current file", activate.action),
list("SaveAs", "gtk-save", "Save _As...", NULL, "Save to a file", activate.action),
list("Quit", "gtk-quit", "_Quit", "<control>Q", "Quit", activate.action),
list("About", NULL, "_About", "<control>A", "About", about.cb),
list("Logo", "rgtk-logo", NULL, NULL, "RGtk", activate.action)
)
# create radio actions for choosing a color and a shape
color.entries <- list(
list("Red", NULL, "_Red", "<control>R", "Blood", 0), # value
list("Green", NULL, "_Green", "<control>G", "Grass", 1),
list("Blue", NULL, "_Blue", "<control>B", "Sky", 2)
)
shape.entries <- list(
list("Square", NULL, "_Square", "<control>S", "Square", 0),
list("Rectangle", NULL, "_Rectangle", "<control>R", "Rectangle", 1),
list("Oval", NULL, "_Oval", "<control>O", "Egg", 2)
)
# create some toggle (on/off) actions
toggle.entries <- list(c("Bold", "gtk-bold", "_Bold", "<control>B", "Bold", activate.action, TRUE)) # active?
# add the RGtk logo to themeable icons
register.stock.icons()
# create a window
window <- gtkWindowNew("toplevel")
window$setDefaultSize(200, 200)
window$setTitle("RGtk is in business")
# add a table layout
table <- gtkTableNew(1, 5, FALSE)
window$add(table)
agroup <- gtkActionGroupNew("AppWindowActions")
# add actions to group with the window widget passed to callbacks
agroup$addActions(entries, window)
agroup$addToggleActions(toggle.entries)
agroup$addRadioActions(color.entries, 0, activate.radio.action)
agroup$addRadioActions(shape.entries, 0, activate.radio.action)
# create a UI manager to read in menus specified in XML
manager <- gtkUIManagerNew()
window$setData("ui-manager", manager)
manager$insertActionGroup(agroup, 0)
window$addAccelGroup(manager$getAccelGroup())
# Define some XML
uistr <- paste(
"<ui>",
" <menubar name='MenuBar'>",
" <menu action='FileMenu'>",
" <menuitem action='New'/>",
" <menuitem action='Open'/>",
" <menuitem action='Save'/>",
" <menuitem action='SaveAs'/>",
" <separator/>",
" <menuitem action='Quit'/>",
" </menu>",
" <menu action='PreferencesMenu'>",
" <menu action='ColorMenu'>",
" <menuitem action='Red'/>",
" <menuitem action='Green'/>",
" <menuitem action='Blue'/>",
" </menu>",
" <menu action='ShapeMenu'>",
" <menuitem action='Square'/>",
" <menuitem action='Rectangle'/>",
" <menuitem action='Oval'/>",
" </menu>",
" <menuitem action='Bold'/>",
" </menu>",
" <menu action='HelpMenu'>",
" <menuitem action='About'/>",
" </menu>",
" </menubar>",
" <toolbar name='ToolBar'>",
" <toolitem action='Open'/>",
" <toolitem action='Quit'/>",
" <separator action='Sep1'/>",
" <toolitem action='Logo'/>",
" </toolbar>",
"</ui>", sep="\n")
manager$addUiFromString(uistr)
menubar <- manager$getWidget("/MenuBar")
menubar$show() # location, layout behavior, padding
table$attach(menubar, 0, 1, 0, 1, yoptions = 0)
bar <- manager$getWidget("/ToolBar")
bar$show()
table$attach(bar, 0, 1, 1, 2, yoptions = 0)
infobar <- gtkInfoBar()
infobar$setNoShowAll(TRUE)
messagelabel <- gtkLabel("")
infobar$getContentArea()$packStart(messagelabel)
infobar$addButton("gtk-ok", GtkResponseType["ok"])
gSignalConnect(infobar, "response", gtkWidgetHide)
table$attach(infobar, 0, 1, 2, 3, yoptions = 0)
# now let the user put some text in the scrolling window
scrolled.window <- gtkScrolledWindow()
scrolled.window$setPolicy("automatic", "automatic")
scrolled.window$setShadowType("in")
table$attach(scrolled.window, 0, 1, 3, 4)
contents <- gtkTextViewNew()
contents$grabFocus()
scrolled.window$add(contents)
# how about a cool status bar?
statusbar <- gtkStatusbarNew() # squeeze it in at the bottom
table$attach(statusbar, 0, 1, 4, 5, yoptions = 0)
buffer <- contents$getBuffer() # statusbar listens to buffer
gSignalConnect(buffer, "changed", update.statusbar, statusbar)
gSignalConnect(buffer, "mark_set", mark.set.callback, statusbar)
# link resize grip to window state
gSignalConnect(window, "window_state_event", update.resize.grip, statusbar)
update.statusbar(buffer, statusbar)
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.