## Part of the DOM API concerned with getting and setting properties
################################################################################
## getProperty()
getPropertyCore <- function(pageID, object, propName, response,
async, callback, tag) {
checkDOMobj(object, pageID)
if (length(object) == 0) {
stop("No object to get property for")
} else if (length(object) > 1) {
warning("More than one object; only using first")
object <- object[1]
}
responseType <- class(response)
msg <- list(type="REQUEST", tag=tag,
body=list(fun="getProperty",
object=as.character(object),
objectType=class(object),
propName=propName,
responseType=responseType))
sendRequest(pageID, msg, tag, async, callback, responseType)
}
setGeneric("getProperty",
function(pageID, object, propName, ...) {
standardGeneric("getProperty")
},
valueClass="DOM_obj_response_OR_error_OR_NULL")
setMethod("getProperty",
signature(pageID="numeric",
object="DOM_obj_ref",
propName="character"),
function(pageID, object, propName, response=NULL,
async=FALSE, callback=NULL, tag=getRequestID()) {
getPropertyCore(pageID, object, propName, response,
async, callback, tag)
})
################################################################################
## Determine whether a property can be used in setProperty()
## Cannot set some properties (e.g., style property on an element)
## https://developer.mozilla.org/en-US/docs/Web/API/CSS_Object_Model/Using_dynamic_styling_information
setGeneric("readonlyProperty",
function(object, propName) {
standardGeneric("readonlyProperty")
})
## Sort of default, catch-all
## If you end up here then DOM basically knows nothing about your
## object so it allows you to have a go at any property you like
setMethod("readonlyProperty",
signature(object="DOM_obj_ref",
propName="character"),
function(object, propName) {
FALSE
})
setMethod("readonlyProperty",
signature(object="DOM_node_ref",
propName="character"),
function(object, propName) {
propName %in% "style"
})
setMethod("readonlyProperty",
signature(object="DOM_CSSRule_ptr",
propName="character"),
function(object, propName) {
propName %in% c("cssText", "parentRule",
"parentStyleSheet", "type",
# For CSSStyleRule
"selectorText", "style")
})
################################################################################
## setProperty()
setPropertyCore <- function(pageID, object, propName, value, warn,
async, callback, tag) {
checkDOMobj(object, pageID)
checkDOMobj(value, pageID)
if (length(object) == 0) {
stop("No object to get property for")
} else if (length(object) > 1) {
warning("More than one object; only using first")
object <- object[1]
}
if (readonlyProperty(object, propName)) {
if (warn) {
warning(paste0("Read-only property '", propName,
"' not set"))
}
invisible()
} else {
msg <- list(type="REQUEST", tag=tag,
body=list(fun="setProperty",
object=as.character(object),
objectType=class(object),
propName=propName,
value=as.character(value),
valueType=class(value)))
sendRequest(pageID, msg, tag, async, callback, "NULL")
}
}
setGeneric("setProperty",
function(pageID, object, propName, value, ...) {
standardGeneric("setProperty")
},
valueClass="DOM_error_OR_NULL")
# In general, the value of the property should be an
# existing DOM object (because it can be a complex object)
setMethod("setProperty",
signature(pageID="numeric",
object="DOM_obj_ref",
propName="character",
value="DOM_obj_ref"),
function(pageID, object, propName, value, warn=TRUE,
async=FALSE, callback=NULL, tag=getRequestID()) {
setPropertyCore(pageID, object, propName, value, warn,
async, callback, tag)
})
# Also allow for simple values (numbers, strings, booleans)
setMethod("setProperty",
signature(pageID="numeric",
object="DOM_obj_ref",
propName="character",
value="DOM_value"),
function(pageID, object, propName, value, warn=TRUE,
async=FALSE, callback=NULL, tag=getRequestID()) {
setPropertyCore(pageID, object, propName, value, warn,
async, callback, tag)
})
################################################################################
## Some convenient syntactic sugar
setMethod("$",
signature(x="DOM_obj_ref"),
function(x, name) {
getProperty(x@pageID, x, name)
})
setMethod("$",
signature(x="DOM_node_literal"),
function(x, name) {
stop("Getting a property on a literal node is not supported")
})
setMethod("$<-",
signature(x="DOM_obj_ref"),
function(x, name, value) {
## If the property is readonly, silently fail
## (silently do nothing because you can set specific style
## properties and we want elt$style$color = "blue" to work)
setProperty(x@pageID, x, name, value, warn=FALSE)
## The main purpose of this call is for its side-effect
## but return the object being modified because that
## retains the pointer to the real browser object
x
})
## A method just to provide a more useful error message in case
## someone lazily does something stupid
setMethod("$<-",
signature(x="DOM_node_literal"),
function(x, name, value) {
stop("Setting a property on a literal node is not supported")
})
## Provide [[ method so can programmatically access style properties
setMethod("[[",
signature(x="DOM_obj_ref"),
function(x, i) {
getProperty(x@pageID, x, i)
})
setMethod("[[",
signature(x="DOM_node_literal"),
function(x, i) {
stop("Getting a property on a literal node is not supported")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.