Skip to content

Commit

Permalink
first commit
Browse files Browse the repository at this point in the history
  • Loading branch information
@jverzani
jverzani committed Sep 28, 2011
0 parents commit 23e7d41
Show file tree
Hide file tree
Showing 57 changed files with 3,434 additions and 0 deletions.
44 changes: 44 additions & 0 deletions DESCRIPTION
@@ -0,0 +1,44 @@
Package: gWidgets2RGtk2
Type: Package
Title: Implementation of gWidgets2 for RGtk2 package
Version: 1.0
Date: 2011-09-18
Author: John Verzani
Maintainer: jverzani@gmail.com
Description: Implements gWidgets2 API for RGtk2
License: GPL-3
Depends:
methods,
memoise,
RGtk2,
gWidgets2
LazyLoad: yes
Collate:
'misc.R'
'gtk-misc.R'
'GComponent.R'
'GContainer.R'
'GWidget.R'
'gbutton.R'
'gwindow.R'
'ggroup.R'
'gframe.R'
'glabel.R'
'gtimer.R'
'gedit.R'
'gcheckbox.R'
'gcheckboxgroup.R'
'icons.R'
'gradio.R'
'gnotebook.R'
'gslider.R'
'gspinbutton.R'
'gexpandgroup.R'
'gstackwidget.R'
'glayout.R'
'gpanedgroup.R'
'gseparator.R'
'gtext.R'
'gcombobox.R'
'gaction.R'
'gcalendar.R'
32 changes: 32 additions & 0 deletions NAMESPACE
@@ -0,0 +1,32 @@
export("font<-.RGtkObject")
export(.addStockIcons.guiWidgetsToolkitRGtk2)
export(.gaction.guiWidgetsToolkitRGtk2)
export(.gbutton.guiWidgetsToolkitRGtk2)
export(.gcalendar.guiWidgetsToolkitRGtk2)
export(.gcheckbox.guiWidgetsToolkitRGtk2)
export(.gcheckboxgroup.guiWidgetsToolkitRGtk2)
export(.gcombobox.guiWidgetsToolkitRGtk2)
export(.gedit.guiWidgetsToolkitRGtk2)
export(.getStockIconByName.guiWidgetsToolkitRGtk2)
export(.getStockIcons.guiWidgetsToolkitRGtk2)
export(.gexpandgroup.guiWidgetsToolkitRGtk2)
export(.gframe.guiWidgetsToolkitRGtk2)
export(.ggroup.guiWidgetsToolkitRGtk2)
export(.glabel.guiWidgetsToolkitRGtk2)
export(.glayout.guiWidgetsToolkitRGtk2)
export(.gnotebook.guiWidgetsToolkitRGtk2)
export(.gpanedgroup.guiWidgetsToolkitRGtk2)
export(.gradio.guiWidgetsToolkitRGtk2)
export(.gseparator.guiWidgetsToolkitRGtk2)
export(.gslider.guiWidgetsToolkitRGtk2)
export(.gspinbutton.guiWidgetsToolkitRGtk2)
export(.gstackwidget.guiWidgetsToolkitRGtk2)
export(.gtext.guiWidgetsToolkitRGtk2)
export(.gtimer.guiWidgetsToolkitRGtk2)
export(.gwindow.guiWidgetsToolkitRGtk2)
export(addToGtkStockIcons)
export(getBlock.RGtkObject)
export(getWidget.RGtkObject)
exportClasses(guiWidgetsToolkitRGtk2)
importClassesFrom(gWidgets2,BasicToolkitInterface)
importClassesFrom(gWidgets2,guiWidgetsToolkit)
201 changes: 201 additions & 0 deletions R/GComponent.R
@@ -0,0 +1,201 @@
##' @include gtk-misc.R
NULL


## Base classes. These are *not* exported, rather each toolkit implementation needs
## to (mostly) provide these same basic classes:
## GComponent
## - GWidget
## - GButton
## - GLabel
## - Others matching the constructors
## -GContainer
## - GWindow
## - GGroup
## - GFrame
## - GExpandGroup
## - GLayout
## - GNotebook
## - GPanedGroup
## - GStacked


##' Base Class for widgets and containers
##'
##' GComponent as parent for GContainer and GWidget.
##' Here we place GtkWidget and GtkObject methods. Container methods in GContainer
##' @importClassesFrom gWidgets2 BasicToolkitInterface
GComponent <- setRefClass("GComponent",
contains="BasicToolkitInterface",
fields=list(
toolkit="ANY",
widget="ANY",
block="ANY",
parent="ANY", # NULL for gwindow, else parent container
handler_id="ANY",
.e="environment"
),
methods=list(
initialize=function(toolkit=guiToolkit(), ...) {
initFields(toolkit=toolkit,
.e=new.env()
)
if(is(handler_id, "unitializedField"))
handler_id <<- NULL

callSuper(...)
},
get_length = function(...) {
"Get length of object. Needed for sapply."
1
},
get_visible = function() widget$getVisible(),
set_visible = function(value) widget$setVisible(as.logical(value)),
get_enabled = function() widget$getSensitive(),
set_enabled = function(value) widget$setSensitive(as.logical(value)),
get_tooltip = function(...) widget$getTooltipText(),
set_tooltip = function(value) widget$setTooltipText(paste(value, collapse="\n")),
## font
set_font = function(obj, value) {
## pass off to widget
tmp <- getWidget(obj)
font(tmp) <- value
},
## tag
get_attr = function(key) {
if(missing(key))
ls(.e)
else
attr(.e, key)
},
set_attr = function(key, value) {
tmp <- .e
attr(tmp, key) <- value
},
is_extant = function() {
"Is widget still available?"
if(is(block, "<invalid>"))
return(FALSE)
else
TRUE
},
get_size=function(...) {
alloc <- block$getAllocation()$allocation
c(width=alloc$width, height=alloc$height)
},
set_size=function(value, ...) {
## Huh??
},

## Work with containers
set_parent = function(parent) parent <<- parent,
add_to_parent = function(parent, child, expand=NULL, fill=NULL, anchor=NULL, ...) {
"Add a child to parent if it is ia container and non null. Dispatches to add_child method of parent"

if(missing(parent) || is.null(parent))
return()

## return here. This is for tcltk compliance
if(is(parent, "GLayout"))
return()

if(!is(parent, "GContainer") && is.logical(parent) && parent) {
tmp <- gwindow(toolkit=toolkit)
tmp$add_child(child, expand, fill, anchor, ...)
return()
}
if(!is(parent, "GContainer")) {
message("parent is not a container")
return()
}

parent$add_child(child, expand, fill, anchor, ...)
},


## RGtk2 handler code
handler_widget = function() widget, # allow override for block (glabel)
add_handler = function(signal, handler, action=NULL, ...) {
if(missing(handler) || is.null(handler))
return(NULL)
##
gSignalConnect(handler_widget(), signal, handler, user.data.first=TRUE, data=list(obj=.self, action=action))
},
## for RGtk2, distinction made here
add_event_handler = function(signal, handler, action=NULL, ...) {
if(missing(handler))
return(NULL)

FUN <- function(h, ...) {
handler(h, ...)
FALSE # need logical
}
gSignalConnect(handler_widget(), signal, FUN, user.data.first=TRUE, data=list(obj=.self, action=action)) },
## typical signal maps
add_handler_clicked = function(handler, action=NULL, ...) {
add_handler("clicked", handler, action, ...)
},
add_handler_focus=function(handler, action=NULL, ...) {
add_event_handler("focus-in-event", handler, action, ...)
},
add_handler_blur=function(handler, action=NULL, ...) {
add_event_handler("focus-out-event", handler, action, ...)
},
keystroke_handler=function(handler, action=NULL, ...) {
f <- function(d, widget, event,...) {
h <- list(obj=d$obj,action=d$action)
h$key <- event$getString() # XXX This is bad -- no locale, ...
state <- event$getState()
if(state == 0)
h$modifier <- NULL
else
h$modifier <- gsub("-mask", "", names(which(state == GdkModifierType)))
handler(h,...)
return(FALSE) # propogate
}
f
},
add_handler_keystroke=function(handler, action=NULL, ...) {
"Keystroke handler. Defined for all, but only gedit, gtext"
if(missing(handler) || is.null(handler))
return()
add_event_handler("key-release-event", keystroke_handler, action, ...)
},
##
emit_signal=function(signal, ..., detail=NULL) {
"Emit signal, for svalue<- assignments, others"
gSignalEmit(widget, signal, ..., detail)
},
##
add_popup_menu = function(menulist, action=NULL, ...) {
XXX("Add popup menu code")
},


## Work with handlers (block, un, remove)
block_handler=function(ID) {
if(missing(ID))
ID <- handler_id
lapply(ID, gSignalHandlerBlock, obj=widget)
},
unblock_handler=function(ID) {
if(missing(ID))
ID <- handler_id
lapply(ID, gSignalHandlerUnblock, obj=widget)
},
remove_handler=function(ID) {
if(missing(ID))
ID <- handler_id
lapply(ID, gSignalHandlerDisconnect, obj=widget)
if(identical(ID, handler_id))
handler_id <<- NULL # zero out if this one
}

)
)

##' exported Subclass of GComponent for users to subclass
##'
##' @exportClasses GComponentRGtk2
GComponentRGtk2 <- setRefClass("GComponentRGtk2",
contains="GComponent")
11 changes: 11 additions & 0 deletions R/GContainer.R
@@ -0,0 +1,11 @@
##' @include GComponent.R
NULL

##' Base class for container objects
GContainer <- setRefClass("GContainer",
contains="GComponent",
fields=list(
children="list"
))


41 changes: 41 additions & 0 deletions R/GWidget.R
@@ -0,0 +1,41 @@
##' @include GComponent.R
NULL

##' Base class for widget objects
GWidget <- setRefClass("GWidget",
contains="GComponent",
fields=list(
coerce_with="ANY" # function
)
)

##' Class to hold widget with items where handlers apply to each item
##'
GWidgetWithItems <- setRefClass("GWidgetWithItems",
contains="GWidget",
fields=list(
widgets="list"
),
methods=list(
add_handler=function(signal, handler, action=NULL) {
"Just adds observer, need to connect widget to call notify_observers"
if(!missing(handler) && is.function(handler)) {
o <- gWidgets2:::observer(.self, handler, action)
invisible(add_observer(o, signal))
}
},
block_handler=function(ID) {
"Block all handlers"
block_observer(ID)
},
unblock_handler=function(ID) {
"unblock all handlers"
unblock_observer(ID)
},
remove_handler=function(ID) {
"remove all handlers"
remove_observer(ID)
}
))


0 comments on commit 23e7d41

Please sign in to comment.