Nothing
missingMsg = function(x) {
if(missing(x)) x = "XXX"
gwCat("This method",x,"needs to be written\n")
}
## toolkit class
## register classes here for toolkits
setClass("guiWidgetsToolkitrJava",
contains="guiWidgetsToolkit",
prototype=prototype(new("guiWidgetsToolkit"))
)
##################################################
## put S3 classes from rJava into S4 classes
## got these from apropos("New") -> try(class(do.call(i,list())))
## oldClasses =
## c(
## "jobjRef"
## )
require(rJava)
setClass("rJavaObject")
#setOldClass("jobjRef")
#setIs("jobjRef","rJavaObject")
## sapply(oldClasses, function(i) {
## setOldClass(i)
## setIs(i,"rJavaObject")
## })
setOldClass("try-error") # for handling try-errors
## a base class which is virtual
##################################################
## A virtual class to hold either RGTK or these guys
## A virtual class for our newly defined objects
## this one contains the ID for the object.
## this may better be done within the NAMESPACE
n=0;assignInNamespace("n",0,"gWidgetsrJava")
getNewID = function() { # get new one, incremented
n = getFromNamespace("n",ns="gWidgetsrJava")
assignInNamespace("n",n+1,ns="gWidgetsrJava")
return(n+1)
}
setClass("gWidgetrJava",
representation(ID="numeric",
e = "environment"),
)
setClassUnion("guiWidgetORgWidgetrJavaORrJavaObject",
c("guiWidget","gWidgetrJava","jobjRef", "rJavaObject"))
## subclss
setClass("gComponentrJava",
representation(
block="guiWidgetORgWidgetrJavaORrJavaObject",
widget="guiWidgetORgWidgetrJavaORrJavaObject",
toolkit="guiWidgetsToolkit"
),
contains="gWidgetrJava",
)
setClass("gContainerrJava",
representation(
block="guiWidgetORgWidgetrJavaORrJavaObject",
widget="guiWidgetORgWidgetrJavaORrJavaObject",
toolkit="guiWidgetsToolkit"
),
contains="gWidgetrJava",
)
##################################################
### Common methods. Specific to a class are put into the file for that class
## we have two definitions. For instance, "svalue" and ".svalue". The "svalue" method dispatches on the object to the .svalue method. This allows us to use svalue instead of .svalue when defining the methods/constructors inside this package.
setMethod("svalue",signature(obj="gWidgetrJava"),
function(obj, index=NULL, drop=NULL, ...) {
.svalue(obj, obj@toolkit, index=index, drop=drop, ...)
})
## svalue
## need method for character
setMethod("svalue",signature(obj="character"),
function(obj, index=NULL, drop=NULL, ...) {
ifelse(length(obj) == 1,
return(getObjectFromString(obj)),
return(obj)
)
})
setMethod(".svalue",signature(toolkit = "guiWidgetsToolkitrJava", obj="character"),
function(obj, toolkit, index=NULL, drop=NULL, ...) {
ifelse(length(obj) == 1,
return(getObjectFromString(obj)),
return(NA)
)
})
## svalue<- -- objec specific
setReplaceMethod("svalue",signature(obj="gWidgetrJava"),
function(obj, index=NULL, ...,value) {
.svalue(obj, obj@toolkit, index=index, ...) <- value
obj
})
## [
setMethod("[",
signature(x="gWidgetrJava"),
function(x,i,j,...,drop=TRUE) {
return(.leftBracket(x, x@toolkit,i,j,...,drop=TRUE))
})
## [<-
setReplaceMethod("[",signature(x="gWidgetrJava"),
function(x,i,j,...,value) {
if(missing(i) && missing(j))
.leftBracket(x, x@toolkit,...) <- value
else if(missing(j))
.leftBracket(x, x@toolkit,i,...) <- value
else
.leftBracket(x, x@toolkit,i,j,...) <- value
return(x)
})
## size ## return size -- not implemented
setMethod("size",signature(obj="gWidgetrJava"),
function(obj, ...) {
cat("size not defined, Set window size with size<-()")
return()
.size(obj, obj@toolkit,...)
})
setMethod(".size",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ...) {
d = obj@widget$getSize() # a Dimension object
return(c(.jfield(d,name="width"),
.jfield(d,name="height")))
})
## size<-
setReplaceMethod("size",signature(obj="gWidgetrJava"),
function(obj, ..., value) {
.size(obj, obj@toolkit,...) <- value
return(obj)
})
setReplaceMethod(".size",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ..., value) {
width = value[1]; height=value[2]
widget = obj@widget
d = .jnew("java/awt/Dimension", as.integer(width), as.integer(height))
.jcall(.jcast(widget,"javax/swing/JComponent"),"V","setMinimumSize",d)
## also set maximum size is possible
return(obj)
})
## visible
setMethod("visible",signature(obj="gWidgetrJava"),
function(obj, set=NULL, ...) {
.visible(obj,obj@toolkit, set=set, ...)
})
setMethod(".visible",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, set=TRUE, ...) {
widget = obj@widget
missingMsg(".visible")
return()
if(as.logical(set))
widget$Show()
else
widget$Hide()
})
## visible<-
setReplaceMethod("visible",signature(obj="gWidgetrJava"),
function(obj, ..., value) {
.visible(obj, obj@toolkit, ...) <- value
return(obj)
})
setReplaceMethod(".visible",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ..., value) {
.visible(obj@widget, toolkit, set=as.logical(value))
return(obj)
})
## enabled -- not implemeneted, don't know how to find sensitive. Would need to keep in
## in the widget using tag or somesuch
setMethod("enabled",signature(obj="gWidgetrJava"),
function(obj, ...) {
.enabled(obj, obj@toolkit,...)
})
setMethod(".enabled",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ...) {
widget = getWidget(obj)
.jcall(.jcast(widget,"java/awt/Component"),"Z","isEnabled")
})
## enabled<-
setReplaceMethod("enabled",signature(obj="gWidgetrJava"),
function(obj, ..., value) {
.enabled(obj, obj@toolkit,...) <- value
return(obj)
})
setReplaceMethod(".enabled",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ..., value) {
widget = getWidget(obj)
.jcall(.jcast(widget,"java/awt/Component"),"V",
"setEnabled",as.logical(value))
return(obj)
})
## tooltip<-
setReplaceMethod(".tooltip",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ..., value) {
widget = getWidget(obj)
.jcall(.jcast(widget,"java/awt/Component"),"V",
"setToolTipText",value)
return(obj)
})
## defaultWidget
setMethod("defaultWidget",
signature(obj = "gWidgetrJava"),
function(obj,...) .defaultWidget(obj,obj@toolkit,...)
)
setMethod(".defaultWidget",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ...) {
.defaultWidget(obj, toolkit) <- TRUE
})
## defaultWidget<-
setReplaceMethod("defaultWidget",signature(obj="gWidgetrJava"),
function(obj, ..., value) {
.defaultWidget(obj, obj@toolkit,...) <- value
return(obj)
})
setReplaceMethod(".defaultWidget",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ..., value) {
## XXX What to do for default widget?
## can do something for buttons, but that's it
return(obj)
})
## focus
setMethod("focus",signature(obj="gWidgetrJava"),
function(obj, ...) {
.focus(obj, obj@toolkit,...)
})
setMethod(".focus",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ...) focus(obj) <- TRUE)
## focus<-
setReplaceMethod("focus",signature(obj="gWidgetrJava"),
function(obj, ..., value) {
.focus(obj, obj@toolkit,...) <- value
return(obj)
})
setReplaceMethod(".focus",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ..., value) {
focus(obj@widget, toolkit, ...) <- value
return(obj)
})
setReplaceMethod(".focus",
signature(toolkit="guiWidgetsToolkitrJava",obj="rJavaObject"),
function(obj, toolkit, ..., value) {
notImplemented("rJavaObject",".focus")
value = as.logical(value)
if(value)
## fpcis obj
return(obj)
})
## font
## weight and style are f*ed up
.font.styles = list(
families = c("normal","sans","serif","monospace"),
weights = c("normal","oblique","italic"),
styles = c("ultra-light","light","normal","bold","ultra-bold","heavy"),
colors = c("black","blue","red","green","brown","yellow","pink")
)
## The .font method is not imported from gWidgets, or exported from gWidgetsrJava. Add this bac if you are going to use this method
setMethod("font",signature(obj="gWidgetrJava"),
function(obj, ...) {
cat("font() not defined. Set fonts with font<-")
return()
.font(obj, obj@toolkit,...)
})
## font<-
setReplaceMethod("font",signature(obj="gWidgetrJava"),
function(obj, ..., value) {
.font(obj, obj@toolkit,...) <- .fixFontMessUp(value)
return(obj)
})
setReplaceMethod(".font",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ..., value) {
## return obj!!
missingMsg(".font<-");return(obj)
##################################################
## This is from RGtk2, need to modify
if(!is.list(value))
value <- lapply(value, function(i) i)
string = ""
if(!is.null(value$family) && value$family %in% .font.styles$families)
string = Paste(string," ",value$family)
if(!is.null(value$weight) && value$weight %in% .font.styles$weights)
string = Paste(string," ",value$weight)
if(!is.null(value$style) && value$style %in% .font.styles$styles)
string = Paste(string," ",value$style)
if(!is.null(value$color) && value$color %in% .font.styles$colors)
string = Paste(string," ",value$color)
if(!is.null(value$size))
string = Paste(string," ",as.integer(value$size))
## fontDescr = pangoFontDescriptionFromString(string)
## getWidget(obj)$ModifyFont(fontDescr)
return(obj)
})
## tag, tag<-
## This is now from gWidgets by default
## In RGtk2 we used the getData() and setData() methods. In rJava I'd like
## to use java/util/Properties, but that doesn't allow enough flexibility for
## values, so instead we use a list in R to do this. The drawback is that when an object is deleted, we don't clear out the contents -- grows without bound!
## ## create namespace object
## #tags = list()
## #assignInNamespace("tags",list(),"gWidgetsrJava")
## ## clear out tags for this ID. Not exported. Is this used?
## Tagsclear = function(obj) {
## id = obj@ID
## tags = getFromNamespace("tags",ns="gWidgetsrJava")
## allKeys = names(tags)
## inds = grep(paste("^",id,"::",sep=""),allKeys)
## if(length(inds) == 0)
## return(NA)
## ## else
## tags[[inds]] <- NULL
## assignInNamespace("tags",tags,ns="gWidgetsrJava")
## }
setMethod("tag",signature(obj="gWidgetrJava"),
function(obj,i,drop=TRUE, ...) {
if(missing(drop)) drop <- TRUE
.tag(obj, obj@toolkit,i, drop=drop,...)
})
## dispatch in *this* toolkit, not present in obj
setMethod("tag",signature(obj="rJavaObject"),
function(obj,i,drop=TRUE, ...) {
if(missing(drop)) drop <- TRUE
.tag(obj, guiToolkit("rJava"),i, drop=drop,...)
})
setMethod(".tag", signature(toolkit="guiWidgetsToolkitrJava",obj="guiWidget"),
function(obj, toolkit, i, drop=TRUE, ...) {
if(missing(i)) i = NULL
if(missing(drop)) drop <- TRUE
.tag(obj@widget,toolkit, i, drop=drop, ...)
})
setMethod(".tag", signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, i, drop=TRUE, ...) {
if(missing(i)) i = NULL
if(missing(drop)) drop <- TRUE
if(is.null(i))
return(as.list(obj@e))
else
return(obj@e[[i]])
## id = obj@ID
## ## get all values for this id
## tags = getFromNamespace("tags",ns="gWidgetsrJava")
## allKeys = names(tags)
## inds = grep(paste("^",id,"::",sep=""),allKeys)
## if(length(inds) == 0)
## return(NULL)
## justTheKeys = sapply(allKeys[inds],function(keyWithID) {
## sub(paste("^",id,"::",sep=""),"",keyWithID)
## })
## tagByKey = list()
## for(key in justTheKeys)
## tagByKey[[key]] = tags[[paste(id,key,sep="::")]]
## if(is.null(i)) return(tagByKey)
## if(drop) {
## if(length(i) == 1)
## return(tagByKey[[i]])
## else
## return(sapply(i, function(j) tagByKey[j]))
## } else {
## return(sapply(i, function(j) tagByKey[j]))
## }
})
## tag <-
setReplaceMethod("tag",signature(obj="gWidgetrJava"),
function(obj, i, replace=TRUE, ..., value) {
.tag(obj, obj@toolkit,i,replace, ...) <- value
return(obj)
})
## dispatch in *this* toolkit, not present in obj
setReplaceMethod("tag",signature(obj="rJavaObject"),
function(obj,i, replace=TRUE, ..., value) {
.tag(obj, guiToolkit("rJava"),i, replace, ...) <- value
return(obj)
})
## objects can be in many different flavors: guiWIdget, gWidgetrJava, rJavaObject
setReplaceMethod(".tag", signature(toolkit="guiWidgetsToolkitrJava",obj="guiWidget"),
function(obj, toolkit, i, replace=TRUE, ..., value) {
if(missing(i)) i = NULL
.tag(obj@widget,toolkit, i, replace, ...) <- value
return(obj)
})
setReplaceMethod(".tag", signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, i, replace=TRUE, ..., value) {
if(missing(i)) i = NULL
obj@e[[i]] <- value
return(obj)
## id = obj@ID
## key = paste(id,i,sep="::")
## ## if we append we need to work a little harder
## tags = getFromNamespace("tags",ns="gWidgetsrJava")
## if(replace==FALSE) {
## value = c(tags[[key]],value)
## }
## tags[[key]] <- value
## assignInNamespace("tags", tags,ns="gWidgetsrJava")
return(obj)
})
## setReplaceMethod(".tag", signature(toolkit="guiWidgetsToolkitrJava",obj="rJavaObject"),
## function(obj, toolkit, i, replace=TRUE, ..., value) {
## if(missing(i) || is.null(i)) {
## warning("Need to specify a key to the 'i' argument of tag<-")
## } else {
## theArgs = list(...)
## replaceIt = as.logical(replace)
## missingMsg(".tag<-");return()
## allData = obj$GetData(".tagKey")
## if(is.null(allData)) allData = list()
## if(replaceIt) {
## allData[[i]] <- value
## } else {
## allData[[i]] <- c(allData[[i]], value)
## }
## obj$SetData(".tagKey", allData)
## }
## return(obj)
## })
##################################################
## id -- define for "ANY" as well
setMethod("id",signature(obj="gWidgetrJava"),
function(obj, ...) {
tag(obj,".rJavaID")
})
setMethod("id",signature(obj="rJavaObject"),
function(obj, ...) {
tag(obj, ".rJavaID", ...)
return(obj)
})
setMethod("id",signature(obj="ANY"),
function(obj, ...) {
if(!is.null(theID<- attr(obj,"id"))) {
return(theID)
} else {
if(is.character(obj)) {
return(obj[1])
} else {
dps = deparse(substitute(obj))
attr(obj,"id") <- dps
return(dps)
}
}
})
setMethod(".id", signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ...) {
tag(obj,".rJavaID", ...)
})
setMethod(".id", signature(toolkit="guiWidgetsToolkitrJava",obj="rJavaObject"),
function(obj, toolkit, ...) {
return(tag(obj,".rJavaID"))
})
## id<-
setReplaceMethod("id",signature(obj="gWidgetrJava"),
function(obj, ..., value) {
tag(obj,".rJavaID", ...) <- value
return(obj)
})
## dispatch in *this* toolkit, not present in obj
setReplaceMethod("id",signature(obj="rJavaObject"),
function(obj, ..., value) {
tag(obj, ".rJavaID", ...) <- value
return(obj)
})
setReplaceMethod("id",signature(obj="ANY"),
function(obj, ..., value) {
attr(obj,"id") <- value
return(obj)
})
## we need a .id to handle dispatch from guiWidgets, otherwise, we use id()
setReplaceMethod(".id", signature(toolkit="guiWidgetsToolkitrJava",
obj="gWidgetrJava"),
function(obj, toolkit, ..., value) {
id(obj, ...) <- value
return(obj)
})
## add method is biggie
## we have several levels of classes here guiWidget -- gWidgetRGkt -- rJavaObject, when
## we get down to that level we can finally add
setMethod("add",signature(obj="gWidgetrJava"),
function(obj, value, ...) {
.add(obj, obj@toolkit,value,...)
})
setMethod(".add",
signature(toolkit="guiWidgetsToolkitrJava",
obj="guiWidget", value="ANY"),
function(obj, toolkit, value, ...) {
cat("Can't add without a value\n")
})
setMethod(".add",
signature(toolkit="guiWidgetsToolkitrJava",
obj="gWidgetrJava", value="try-error"),
function(obj, toolkit, value, ...) {
gmessage(paste("Error:",obj))
})
## pushdonw
setMethod(".add",
signature(toolkit="guiWidgetsToolkitrJava",
obj="guiWidget", value="guiWidgetORgWidgetrJavaORrJavaObject"),
function(obj, toolkit, value, ...) {
.add(obj@widget, toolkit, value, ...)
})
## for gWindow
setMethod(".add",
signature(toolkit="guiWidgetsToolkitrJava",
obj="gContainerrJava", value="guiWidget"),
function(obj, toolkit, value, ...) {
.add(obj, toolkit, value@widget, ...)
})
## for gContainer
setMethod(".add",
signature(toolkit="guiWidgetsToolkitrJava",obj="gContainerrJava", value="gWidgetrJava"),
function(obj, toolkit, value, ...) {
theArgs = list(...)
expand = if(is.null(theArgs$expand)) FALSE else theArgs$expand
tag(value, "parentContainer") <- obj
cont = getWidget(obj)
widget = getBlock(value)
if(expand) {
maxValue = 1600 # MAX_VALUE isn't working
d = .jnew("java/awt/Dimension",as.integer(maxValue),as.integer(maxValue))
.jcall(.jcast(widget, "java/awt/Component"),"V",
"setMaximumSize",d)
}
anchor = theArgs$anchor
## initial placement high and outside! This is GTK2 like
if(is.null(anchor)) anchor = c(-1,1)
if(!is.null(anchor)) {
tmp = .jcast(widget,"java/awt/Component")
if(anchor[1] == 1)
.jcall(widget,"V","setAlignmentX",.jfloat(.jfield(tmp,name="RIGHT_ALIGNMENT")))
else if(anchor[1] == 0)
.jcall(widget,"V","setAlignmentX",.jfloat(.jfield(tmp,name="CENTER_ALIGNMENT")))
else
.jcall(widget,"V","setAlignmentX",.jfloat(.jfield(tmp,name="LEFT_ALIGNMENT")))
if(anchor[2] == 1)
.jcall(widget,"V","setAlignmentY",.jfloat(.jfield(tmp,name="TOP_ALIGNMENT")))
else if(anchor[2] == 0)
.jcall(widget,"V","setAlignmentY",.jfloat(.jfield(tmp,name="CENTER_ALIGNMENT")))
else
.jcall(widget,"V","setAlignmentY",.jfloat(.jfield(tmp,name="BOTTOM_ALIGNMENT")))
}
.jcall(cont,"Ljava/awt/Component;", "add",
.jcast(widget, "java/awt/Component"))
## update
.jcall(cont, "V", "invalidate")
.jcall(cont, "V", "validate")
## pack
top <- getTopLevel(obj)
if(!is.null(top)) {
.jcall(getBlock(top), "V", "pack")
}
})
## setMethod(".add",
## signature(toolkit="guiWidgetsToolkitrJava",obj="gContainerrJava", value="gWidgetrJava"),
## function(obj, toolkit, value, ...) {
## .add(obj, toolkit, value@block, ...)
## })
## addSPring, addSpace
setMethod("addSpring",signature(obj="gWidgetrJava"),
function(obj, ...) {
.addSpring(obj, obj@toolkit,...)
})
setMethod(".addSpring",
signature(toolkit="guiWidgetsToolkitrJava",obj="gContainerrJava"),
function(obj, toolkit, ...) {
## is glue the right thing here?
tmp = obj@widget
if(obj@horizontal)
glue = tmp$createHorizontalGlue()
else
glue = tmp$createVerticalGlue()
.jcall(tmp,"Ljava/awt/Component;","add",
.jcast(glue,"java/awt/Component"))
})
setMethod("addSpace",signature(obj="gWidgetrJava"),
function(obj, value, ...) {
.addSpace(obj,obj@toolkit,value,...)
})
setMethod(".addSpace",
signature(toolkit="guiWidgetsToolkitrJava",obj="gContainerrJava"),
function(obj, toolkit, value, ...) {
theArgs = list(...)
horizontal = ifelse(is.null(theArgs$horizontal),
TRUE,
as.logical(theArgs$horizontal))
## use createRigidArea with Dimension
if(horizontal)
d = .jnew("java/awt/Dimension",as.integer(value),as.integer(0))
else
d = .jnew("java/awt/Dimension",as.integer(0),as.integer(value))
cont = getWidget(obj)
tmp = cont$createRigidArea(d)
## tmp = .jcall(.jcast(getWidget(obj),"javax/swing/Box"),
## "Ljava/awt/Component;",
## "createRigidArea",d)
## now add to box
.jcall(cont,
"Ljava/awt/Component;",
"add",
.jcast(tmp,"java/awt/Component"))
})
## delete -- get down to two rJavaObjects
setMethod("delete",signature(obj="gWidgetrJava"),
function(obj, widget, ...) {
.delete(obj, obj@toolkit,widget,...)
})
## push down to rJava vs rJava. Can be 9 possiblities!
setMethod(".delete",
signature(toolkit="guiWidgetsToolkitrJava",obj="gContainerrJava",widget="guiWidget"),
function(obj, toolkit, widget, ...) {
.delete(obj, toolkit, widget@widget, ...)
})
setMethod(".delete",
signature(toolkit="guiWidgetsToolkitrJava",obj="gContainerrJava",widget="gWidgetrJava"),
function(obj, toolkit, widget, ...) {
## call remove on container
cont = getWidget(obj)
widget = getWidget(widget)
.jcall(cont, "V", "remove", .jcast(widget, "java/awt/Component"))
})
## dispose -- delete the parent window, or something else
setMethod("dispose",signature(obj="gWidgetrJava"),
function(obj, ...) {
.dispose(obj, obj@toolkit,...)
})
setMethod(".dispose",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ...) {
missingMsg(".dispose");return()
})
## update
setMethod("update",signature(object="gWidgetrJava"),
function(object, ...) {
.update(object, object@toolkit, ...)
})
setMethod(".update",
signature(toolkit="guiWidgetsToolkitrJava",object="gComponentrJava"),
function(object, toolkit, ...) {
missingMsg(".update");return()
object@widget$QueueDraw()
})
##
##
##################################################
##################################################
## handlers
##
## basic handler for adding with a signal.
setGeneric("addhandler", function(obj, signal, handler, action=NULL, ...)
standardGeneric("addhandler"))
setMethod("addhandler",signature(obj="guiWidget"),
function(obj, signal, handler, action=NULL, ...) {
.addHandler(obj@widget, obj@toolkit, signal, handler, action, ...)
})
setMethod("addhandler",signature(obj="gWidgetrJava"),
function(obj, signal, handler, action=NULL, ...) {
.addHandler(obj, obj@toolkit, signal, handler, action, ...)
})
setMethod("addhandler",signature(obj="rJavaObject"),
function(obj, signal, handler, action=NULL, ...) {
.addHandler(obj, guiToolkit("rJava"), signal, handler, action, ...)
})
## method for dispatch
setGeneric(".addHandler",
function(obj, toolkit,
signal, handler, action=NULL, ...)
standardGeneric(".addHandler"))
setMethod(".addHandler",
signature(toolkit="guiWidgetsToolkitrJava",obj="guiWidget"),
function(obj, toolkit,
signal, handler, action=NULL, ...) {
.addHandler(obj@widget, toolkit, signal, handler, action, ...)
})
setMethod(".addHandler",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
signal, handler, action=NULL, ...) {
## missingMsg(".addHandler");return()
## ## need to return TRUE
## modifyHandler = function(...) {
## handler(...)
## return(TRUE)
## }
## callbackID <- try(connectSignal(getWidget(obj), ### issue: getWidget(obj),
## signal=signal,
## f=modifyHandler,
## data=list(obj=obj, action=action,...),
## user.data.first = TRUE,
## after = FALSE), silent=FALSE)
## if(inherits(callbackID,"try-error")) {
## cat("Couldn't add signal: ",signal," for object of class:")
## cat(class(obj))
## return(NA)
## } else {
## ## now put handler into object
## handler.ID = tag(obj, "handler.id")
## if(is.null(handler.ID))
## handler.ID =list()
## handler.ID[[length(handler.ID)+1]] = callbackID
## tag(obj, "handler.id") <- handler.ID
## ##
## ## addhandlerdestroy(obj, handler=function(h,...)
## ## removehandler(h$obj,h$action),
## ## action=ID)
## ## return ID
## invisible(callbackID)
## }
})
setMethod(".addHandler",
signature(toolkit="guiWidgetsToolkitrJava",obj="rJavaObject"),
function(obj, toolkit, signal, handler, action=NULL, ...) {
## callbackID <- try(connectSignal(obj,
## signal=signal,
## f=handler,
## data=list(obj=obj, action=action, ...),
## user.data.first = TRUE,
## after = FALSE),
## silent=TRUE)
## ## can't' stuff in handler IDS
## if(inherits(callbackID,"try-error")) {
## cat("Couldn't connect signal:",signal,"for")
## print(obj)
## return(NA)
## } else {
## invisible(callbackID)
## }
})
## removew handler
## removehandler
setMethod("removehandler", signature("gWidgetrJava"),
function(obj, ID=NULL, ...) {
.removehandler(obj, obj@toolkit, ID, ...)
})
setMethod("removehandler", signature("rJavaObject"),
function(obj, ID=NULL, ...) {
.removehandler(obj, guiToolkit("rJava"), ID, ...)
})
setMethod(".removehandler",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ID=NULL, ...) {
## ID here has two components
type = ID[1]
handlerID=as.character(ID[2])
ID = as.character(obj@ID)
## remove from list
allHandlers = getFromNamespace("allHandlers",ns="gWidgetsrJava")
## is this a idleHandler
if(type == "addIdleListener") {
t = allHandlers[[ID]][[type]][[handlerID]]$timer
t = .jcall(t,"V","stopTimer")
}
allHandlers[[ID]][[type]][[handlerID]]<-NULL
## now store the hash
assignInNamespace("allHandlers",allHandlers,ns="gWidgetsrJava")
})
## blockhandler
setMethod("blockhandler", signature("gWidgetrJava"),
function(obj, ID=NULL, ...) {
.blockhandler(obj, obj@toolkit, ID, ...)
})
setMethod("blockhandler", signature("rJavaObject"),
function(obj, ID=NULL, ...) {
.blockhandler(obj, guiToolkit("rJava"), ID, ...)
})
setMethod(".blockhandler",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ID=NULL, ...) {
.blockhandler(getWidget(obj),toolkit,ID,...)
})
setMethod(".blockhandler",
signature(toolkit="guiWidgetsToolkitrJava",obj="rJavaObject"),
function(obj, toolkit, ID=NULL, ...) {
cat("define block handler\n")
})
## unblock handler
setMethod("unblockhandler", signature("gWidgetrJava"),
function(obj, ID=NULL, ...) {
.unblockhandler(obj, obj@toolkit, ID, ...)
})
setMethod("unblockhandler", signature("rJavaObject"),
function(obj, ID=NULL, ...) {
.unblockhandler(obj, guiToolkit("rJava"), ID, ...)
})
setMethod(".unblockhandler",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, ID=NULL, ...) {
.blockhandler(getWidget(obj),toolkit,ID,...)
})
setMethod(".unblockhandler",
signature(toolkit="guiWidgetsToolkitrJava",obj="rJavaObject"),
function(obj, toolkit, ID=NULL, ...) {
cat("define unblock handler\n")
})
## addhandlerchanged
setMethod("addhandlerchanged",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerchanged(obj, obj@toolkit, handler, action, ...)
})
setMethod("addhandlerchanged",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerchanged(obj, guiToolkit("rJava"), handler, action, ...)
})
setMethod("addhandlerchanged",signature(obj="ANY"),
function(obj, handler=NULL, action=NULL, ...) {
cat("No method addhandlerchanged for object of class",class(obj),"\n")
})
setMethod(".addhandlerchanged",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
.addHandler(obj, toolkit, signal="changed",
handler=handler, action=action, ...)
})
## expose: expose-event or realize
setMethod("addhandlerexpose",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerexpose(obj,obj@toolkit,handler, action, ...)
})
setMethod("addhandlerexpose",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerexpose(obj, guiToolkit("rJava"), handler, action, ...)
})
setMethod(".addhandlerexpose",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
.addHandler(obj, toolkit, signal="expose-event",
handler=handler, action=action, ...)
})
setMethod(".addhandlerexpose",
signature(toolkit="guiWidgetsToolkitrJava",obj="gComponentrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
.addHandler(obj,toolkit, signal="realize",
handler=handler, action=action, ...)
})
## unrealize: unrealize
setMethod("addhandlerunrealize",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerunrealize(obj, obj@toolkit,handler, action, ...)
})
setMethod("addhandlerunrealize",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerunrealize(obj, guiToolkit("rJava"),handler, action, ...)
})
setMethod(".addhandlerunrealize",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
.addHandler(obj, toolkit, signal="unrealize",
handler=handler, action=action, ...)
})
## destroy: destroy
setMethod("addhandlerdestroy",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerdestroy(obj, obj@toolkit,handler, action, ...)
})
setMethod("addhandlerdestroy",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerdestroy(obj, guiToolkit("rJava"),handler, action, ...)
})
setMethod(".addhandlerdestroy",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
.addHandler(obj, toolkit, signal="destroy",
handler=handler, action=action, ...)
})
## keystroke: changed
setMethod("addhandlerkeystroke",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerkeystroke(obj, obj@toolkit,handler, action, ...)
})
setMethod("addhandlerkeystroke",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerkeystroke(obj, guiToolkit("rJava"),handler, action, ...)
})
setMethod(".addhandlerkeystroke",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
.addHandler(obj, toolkit, signal="changed",
handler=handler, action=action, ...)
})
## clicked: clicked
setMethod("addhandlerclicked",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerclicked(obj, obj@toolkit,handler, action, ...)
})
setMethod("addhandlerclicked",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerclicked(obj, guiToolkit("rJava"),handler, action, ...)
})
setMethod(".addhandlerclicked",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
.addHandler(obj, toolkit, signal="clicked",
handler=handler, action=action, ...)
})
## doubleclick: no default
setMethod("addhandlerdoubleclick",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerdoubleclick(obj,obj@toolkit,handler, action, ...)
})
setMethod("addhandlerdoubleclick",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerdoubleclick(obj,guiToolkit("rJava"),handler, action, ...)
})
setMethod(".addhandlerdoubleclick",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
cat("No default handler for double click")
})
## rightclick: button-press-event -- handle separately
setMethod("addhandlerrightclick",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerrightclick(obj,obj@toolkit,handler, action, ...)
})
setMethod("addhandlerrightclick",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerrightclick(obj,guiToolkit("rJava"),handler, action, ...)
})
setMethod(".addhandlerrightclick",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
## implement for rJava
## connectSignal(obj@widget,
## signal = "button-press-event",
## f = function(h, eventButton,...) {
## if(eventButton$GetButton() == 3) {
## h$handler(h,...)
## }
## return(FALSE) # continue propagation
## },
## data = list(obj=obj, action=action, handler=handler),
## user.data.first = TRUE,
## after = FALSE
## )
})
## mouse motion -- like mouseover
setMethod("addhandlermousemotion",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlermousemotion(obj,obj@toolkit,handler, action, ...)
})
setMethod("addhandlermousemotion",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlermousemotion(obj,guiToolkit("rJava"),handler, action, ...)
})
setMethod(".addhandlermousemotion",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
cat("No default handler for mouse motion")
})
## blur -- leave widget
setMethod("addhandlerblur",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerblur(obj,obj@toolkit,handler, action, ...)
})
setMethod("addhandlerblur",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.addhandlerblur(obj,guiToolkit("rJava"),handler, action, ...)
})
setMethod(".addhandlerblur",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler, action=NULL, ...) {
cat("No default handler for blur")
})
## idle
setMethod("addhandleridle",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, interval=1000, ...) {
.addhandleridle(obj, obj@toolkit,
handler=handler, action=action, interval=interval, ...)
})
setMethod("addhandleridle",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, interval=1000, ...) {
.addhandleridle(obj, guiToolkit("rJava"),
handler=handler, action=action, interval=interval, ...)
})
setMethod(".addhandleridle",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit,
handler=NULL, action=NULL, interval=1000, ...) {
## call gIdle. Using handler set up in aaaHandler
## for now, only one such timer
handlerID = as.character(1)
ID = as.character(obj@ID)
allHandlers = getFromNamespace("allHandlers",ns="gWidgetsrJava")
if(!is.list(allHandlers))
if(is.null(allHandlers[[ID]]))
allHandlers[[ID]] <- list()
if(is.null(allHandlers[[ID]][["addIdleListener"]]))
allHandlers[[ID]][["addIdleListener"]] <- list()
allHandlers[[ID]][["addIdleListener"]][[handlerID]] = list(
handler=handler,
obj = obj,
action=action,
envir=parent.frame()
)
## NOW call timer
t = .jnew("gWidgetsrJava/gIdle",as.integer(interval),as.integer(ID))
## shove into handlers to be able to stop
allHandlers[[ID]][["addIdleListener"]][[handlerID]]$timer=t
## store list
assignInNamespace("allHandlers",allHandlers,ns="gWidgetsrJava")
return(c("addIdleListener",handlerID))
})
## addpopumenu
setMethod("addpopupmenu",signature(obj="gWidgetrJava"),
function(obj, menulist, action=NULL, ...) {
.addpopupmenu(obj, obj@toolkit,menulist, action, ...)
})
setMethod("addpopupmenu",signature(obj="rJavaObject"),
function(obj, menulist, action=NULL, ...) {
.addpopupmenu(obj, guiToolkit("rJava"), menulist, action, ...)
})
## ## this does not get exported
addPopupMenuWithSignal = function(obj, toolkit, menulist, action=NULL, signal="button-press-event", ...) {
cat("addPopupMenuWithSignal not implemented in gWidgetrJava\n")
return()
}
## theArgs = list(...)
## missingMsg("addPopupMenuWithSignal");return()
## f = function(h, ...) {
## mb = gmenu(h$action, popup = TRUE)
## event = gdkEventNew(GdkEventType["button-press"])
## mb = tag(mb,"mb") # the real menu bar
## gtkMenuPopupHack(mb, button = event$GetButton(),
## activate.time=event$GetTime()
## )
## }
## ## .addhandler not exported
## callbackID = .addHandler(obj,toolkit, signal = signal,handler=f, action=menulist)
## invisible(callbackID)
## }
add3rdMousePopupMenuWithSignal = function(obj, toolkit, menulist, action=NULL, signal="button-press-event", ...) {
cat("3rd mouse popup not implemented in gWidgetsrJava\n")
return()
}
## f = function(h, widget, event,...) {
## if(event$GetButton() != 3) {
## return(FALSE) # propogate signal
## } else {
## mb = gmenu(h$action$menulist, popup = TRUE, action=h$action$passedaction)
## mb = tag(mb,"mb") # actual widget
## gtkMenuPopupHack(mb,button = event$GetButton(),
## activate.time=event$GetTime()
## )
## }
## }
## callbackID = .addHandler(obj,toolkit, signal = "button-press-event",handler=f, action=list(menulist=menulist, passedaction=action))
## invisible(callbackID)
## }
### need to deal with action
setMethod(".addpopupmenu",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, menulist, action=NULL, ...) {
addPopupMenuWithSignal(obj, toolkit, menulist, ...)
})
## add3rdmousepopupmenu
setMethod("add3rdmousepopupmenu",signature(obj="gWidgetrJava"),
function(obj, menulist, action=NULL, ...) {
.add3rdmousepopupmenu(obj, obj@toolkit,menulist, action, ...)
})
setMethod("add3rdmousepopupmenu",signature(obj="rJavaObject"),
function(obj, menulist, action=NULL,...) {
.add3rdmousepopupmenu(obj, guiToolkit("rJava"),menulist, action,...)
})
setMethod(".add3rdmousepopupmenu",
signature(toolkit="guiWidgetsToolkitrJava",obj="gWidgetrJava"),
function(obj, toolkit, menulist,action=NULL, ...) {
add3rdMousePopupMenuWithSignal(obj, toolkit,
menulist, action, ...)
})
setMethod(".add3rdmousepopupmenu",
signature(toolkit="guiWidgetsToolkitrJava",obj="rJavaObject"),
function(obj, toolkit, menulist, action=NULL, ...) {
add3rdMousePopupMenuWithSignal(obj, toolkit,
menulist, action, ...)
})
## "dotmethods" defined in dnd.R
## adddropsource
setMethod("adddropsource",signature(obj="gWidgetrJava"),
function(obj, targetType="text", handler=NULL, action=NULL, ...) {
.adddropsource(obj, obj@toolkit,targetType=targetType,
handler=handler, action=action, ...)
})
setMethod("adddropsource",signature(obj="rJavaObject"),
function(obj, targetType="text", handler=NULL, action=NULL, ...) {
.adddropsource(obj, guiToolkit("rJava"),targetType=targetType,
handler=handler, action=action, ...)
})
## adddropmotion
setMethod("adddropmotion",signature(obj="gWidgetrJava"),
function(obj, handler=NULL, action=NULL, ...) {
.adddropmotion(obj, obj@toolkit,
handler=handler, action=action, ...)
})
setMethod("adddropmotion",signature(obj="rJavaObject"),
function(obj, handler=NULL, action=NULL, ...) {
.adddropmotion(obj, guiToolkit("rJava"),
handler=handler, action=action, ...)
})
## adddroptarget
setMethod("adddroptarget",signature(obj="gWidgetrJava"),
function(obj, targetType="text", handler=NULL, action=NULL, ...) {
.adddroptarget(obj, obj@toolkit,targetType=targetType,
handler=handler, action=action, ...)
})
setMethod("adddroptarget",signature(obj="rJavaObject"),
function(obj, targetType="text", handler=NULL, action=NULL, ...) {
.adddroptarget(obj, guiToolkit("rJava"),targetType=targetType,
handler=handler, action=action, ...)
})
## R Methods
setMethod("dim", "gWidgetrJava", function(x) .dim(x,x@toolkit))
setMethod(".dim",
signature(toolkit="guiWidgetsToolkitrJava",x="gWidgetrJava"),
function(x,toolkit) {
cat("Define dim for x of class:")
print(class(x))
return(NULL)
})
setMethod("length", "gWidgetrJava", function(x) .length(x,x@toolkit))
setMethod(".length",
signature(toolkit="guiWidgetsToolkitrJava",x="gWidgetrJava"),
function(x,toolkit) {
cat("Define length for x of class:")
print(class(x))
return(NULL)
})
setMethod("dimnames", "gWidgetrJava", function(x) .dimnames(x,x@toolkit))
setReplaceMethod("dimnames",
signature(x="gWidgetrJava"),
function(x,value) {
.dimnames(x,x@toolkit) <- value
return(x)
})
## as of 2.5.0 this became primiive
if(as.numeric(R.Version()$major) <= 2 &
as.numeric(R.Version()$minor) <= 4.1) {
setGeneric("names")
setGeneric("names<-")
}
setMethod("names", "gWidgetrJava", function(x) .names(x,x@toolkit))
setReplaceMethod("names",
signature(x="gWidgetrJava"),
function(x,value) {
.names(x,x@toolkit) <- value
return(x)
})
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.