[rkward-cvs] SF.net SVN: rkward-code:[4895] trunk/rkward/packages/rkwarddev
m-eik at users.sf.net
m-eik at users.sf.net
Sun Oct 12 13:19:07 UTC 2014
Revision: 4895
http://sourceforge.net/p/rkward/code/4895
Author: m-eik
Date: 2014-10-12 13:19:06 +0000 (Sun, 12 Oct 2014)
Log Message:
-----------
rkwarddev: rk.XMLradio() now stores the ID of rk.XML.option() child nodes, and logic objects use parentID.optionID automatically if the option object is used. while at it, cleaning up the code a bit
Modified Paths:
--------------
trunk/rkward/packages/rkwarddev/DESCRIPTION
trunk/rkward/packages/rkwarddev/R/id.R
trunk/rkward/packages/rkwarddev/R/rk-internal.R
trunk/rkward/packages/rkwarddev/R/rk.JS.ite-class.R
trunk/rkward/packages/rkwarddev/R/rk.JS.var-class.R
trunk/rkward/packages/rkwarddev/R/rk.XML.connect.R
trunk/rkward/packages/rkwarddev/R/rk.XML.convert.R
trunk/rkward/packages/rkwarddev/R/rk.XML.entry.R
trunk/rkward/packages/rkwarddev/R/rk.XML.formula.R
trunk/rkward/packages/rkwarddev/R/rk.XML.insert.R
trunk/rkward/packages/rkwarddev/R/rk.XML.option.R
trunk/rkward/packages/rkwarddev/R/rk.XML.pluginmap.R
trunk/rkward/packages/rkwarddev/R/rk.XML.radio.R
trunk/rkward/packages/rkwarddev/R/rk.XML.snippets.R
trunk/rkward/packages/rkwarddev/R/rk.XML.varslot.R
trunk/rkward/packages/rkwarddev/R/rk.plugin.component.R
trunk/rkward/packages/rkwarddev/R/rk.plugin.skeleton.R
trunk/rkward/packages/rkwarddev/R/rk.rkh.doc.R
trunk/rkward/packages/rkwarddev/R/rk.rkh.related.R
trunk/rkward/packages/rkwarddev/R/rk.set.comp.R
trunk/rkward/packages/rkwarddev/R/rk.set.language.R
trunk/rkward/packages/rkwarddev/R/rk.set.rkh.prompter.R
trunk/rkward/packages/rkwarddev/R/rkwarddev-package.R
trunk/rkward/packages/rkwarddev/R/tf.R
trunk/rkward/packages/rkwarddev/inst/doc/rkwarddev_vignette.pdf
trunk/rkward/packages/rkwarddev/man/rk.XML.option.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.radio.Rd
trunk/rkward/packages/rkwarddev/man/rkwarddev-package.Rd
Modified: trunk/rkward/packages/rkwarddev/DESCRIPTION
===================================================================
--- trunk/rkward/packages/rkwarddev/DESCRIPTION 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/DESCRIPTION 2014-10-12 13:19:06 UTC (rev 4895)
@@ -15,7 +15,7 @@
Authors at R: c(person(given="Meik", family="Michalke",
email="meik.michalke at hhu.de", role=c("aut", "cre")))
Version: 0.06-5
-Date: 2014-10-11
+Date: 2014-10-12
Collate:
'echo.R'
'i18n.R'
Modified: trunk/rkward/packages/rkwarddev/R/id.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/id.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/id.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -67,10 +67,10 @@
}
return(node.id)
} else if(inherits(this.part, "rk.JS.arr")){
- node.id <- this.part at opt.name
+ node.id <- slot(this.part, "opt.name")
return(node.id)
} else if(inherits(this.part, "rk.JS.opt")){
- node.id <- this.part at var.name
+ node.id <- slot(this.part, "var.name")
return(node.id)
} else if(inherits(this.part, "rk.JS.var")){
# can hold multiple IDs, but we'll only return the first valid one
Modified: trunk/rkward/packages/rkwarddev/R/rk-internal.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk-internal.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk-internal.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -617,13 +617,21 @@
## function check.ID()
-check.ID <- function(node){
+# - node: a XiMpLe.node to search for an ID
+# - search.environment: if TRUE, the internal environment is searched for the ID
+# as well; a use case for this is IDs of oprions, which need their parent IDs as well;
+# see get.optionIDs() below
+check.ID <- function(node, search.environment=FALSE){
if(is.list(node)){
return(sapply(node, check.ID))
} else {}
if(is.XiMpLe.node(node)){
node.ID <- XMLAttrs(node)[["id"]]
+ if(isTRUE(search.environment)){
+ optionIDs <- get.optionIDs()[[node.ID]]
+ node.ID <- ifelse(is.null(optionIDs), node.ID, optionIDs[["XML"]])
+ } else {}
} else if(is.character(node)){
node.ID <- node
} else {
@@ -804,13 +812,18 @@
# - node: a XiMpLe.node object to check
# - warn: warning or stop?
# - see: name of the function to check docs for
-valid.parent <- function(parent, node, warn=FALSE, see=NULL){
+# - arg.name: optional argument name of a function where valid.parent() is called from,
+# e.g. if an object is given via "cbox" but checked for "checkbox"
+valid.parent <- function(parent, node, warn=FALSE, see=NULL, arg.name=NULL){
if(is.XiMpLe.node(node)){
node.name <- XMLName(node)
if(identical(node.name, parent)){
return(TRUE)
} else {
- return.message <- paste0("I don't know what this is, but '", parent, "' is not a <", parent, "> section!")
+ if(is.null(arg.name)){
+ arg.name <- parent
+ } else {}
+ return.message <- paste0("I don't know what this is, but '", arg.name, "' is not a <", parent, "> section!")
if(isTRUE(warn)){
warning(return.message)
return(FALSE)
@@ -1164,24 +1177,48 @@
return(results)
} ## end function dependenciesCompatWrapper()
+## function get.rk.env()
+# generic function to query the internal environment and declare a desired object, if not present yet
+get.rk.env <- function(name, value=list()){
+ if(exists(name, envir=.rkdev.env, inherits=FALSE)){
+ this.env <- as.list(.rkdev.env)[[name]]
+ } else {
+ assign(name, value, envir=.rkdev.env)
+ this.env <- value
+ }
+ return(this.env)
+} ## end function get.rk.env()
+
+## function set.rk.env()
+# generic function to write to the internal environment
+set.rk.env <- function(name, value){
+ assign(name, value, envir=.rkdev.env)
+ return(invisible(NULL))
+} ## end function set.rk.env()
+
+
## function get.rkh.prompter()
# returns either an empty list or the contents of rkh.prompter from the internal enviroment
get.rkh.prompter <- function(){
- if(exists("rkh.prompter", envir=.rkdev.env, inherits=FALSE)){
- rkh.prompter <- as.list(.rkdev.env)[["rkh.prompter"]]
- } else {
- assign("rkh.prompter", list(), envir=.rkdev.env)
- rkh.prompter <- list()
- }
+ rkh.prompter <- get.rk.env("rkh.prompter", value=list())
return(rkh.prompter)
} ## end function get.rkh.prompter()
+## function get.optionIDs()
+# returns either an empty list or the contents of rkh.prompter from the internal enviroment
+get.optionIDs <- function(){
+ optionIDs <- get.rk.env("optionIDs", value=list())
+ return(optionIDs)
+} ## end function get.optionIDs()
+
+
## function rk.check.options()
-# options is a list, containig either named vectors in teh form of
-# label=c(val=NULL, chk=FALSE)
-# or an "option" node of class XiMpLe.node
+# - options: a list, containig either named vectors in the form of
+# label=c(val=NULL, chk=FALSE)
+# or an "option" node of class XiMpLe.node
+# - parent: the parent node type, e.g. "radio"
rk.check.options <- function(options, parent){
num.opt <- length(options)
all.options <- sapply(1:num.opt, function(this.num){
@@ -1215,3 +1252,34 @@
return(all.options)
}
## end function rk.check.options()
+
+
+## function rk.register.options()
+# - options: a list, containig either named vectors in the form of
+# label=c(val=NULL, chk=FALSE)
+# or an "option" node of class XiMpLe.node; only the latter will be
+# searched for IDs
+# - parent.node: full parent XiMpLe.node option IDs will be registered in
+# an internal environment, which makes it easier to fetch a directly
+# usable ID (because it has to be prefixed with the parent ID)
+rk.register.options <- function(options, parent.node){
+ num.opt <- length(options)
+ all.options <- sapply(1:num.opt, function(this.num){
+ if(is.XiMpLe.node(options[[this.num]])){
+ opt.id <- XMLAttrs(options[[this.num]])[["id"]]
+ if(!is.null(opt.id)){
+ # save ID with parents
+ optionIDs <- get.optionIDs()
+ thisID <- c(XML=id(options[[this.num]], js=FALSE), JS=id(options[[this.num]]))
+ parentID <- c(XML=id(parent.node, js=FALSE), JS=id(parent.node))
+ optionIDs[[opt.id]] <- list(
+ XML=paste(parentID[["XML"]], thisID[["XML"]], sep="."),
+ JS=paste(parentID[["JS"]], thisID[["JS"]], sep="."),
+ parent=parentID
+ )
+ set.rk.env("optionIDs", value=optionIDs)
+ } else {}
+ } else {}
+ })
+}
+## end function rk.register.options()
\ No newline at end of file
Modified: trunk/rkward/packages/rkwarddev/R/rk.JS.ite-class.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.JS.ite-class.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.JS.ite-class.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -39,19 +39,19 @@
)
setValidity("rk.JS.ite", function(object){
- if(length(object at thenifJS) > 1){
+ if(length(slot(object, "thenifJS")) > 1){
stop(simpleError("Slot 'thenifJS' can only have one list element!"))
} else {}
- if(length(object at thenifJS) == 1){
- if(!inherits(object at thenifJS[[1]], "rk.JS.ite")){
+ if(length(slot(object, "thenifJS")) == 1){
+ if(!inherits(slot(object, "thenifJS")[[1]], "rk.JS.ite")){
stop(simpleError("Slot 'thenifJS' can only have one list element of class 'rk.JS.ite'!"))
} else {}
} else {}
- if(length(object at elifJS) > 1){
+ if(length(slot(object, "elifJS")) > 1){
stop(simpleError("Slot 'elifJS' can only have one list element!"))
} else {}
- if(length(object at elifJS) == 1){
- if(!inherits(object at elifJS[[1]], "rk.JS.ite")){
+ if(length(slot(object, "elifJS")) == 1){
+ if(!inherits(slot(object, "elifJS")[[1]], "rk.JS.ite")){
stop(simpleError("Slot 'elifJS' can only have one list element of class 'rk.JS.ite'!"))
} else {}
} else {}
Modified: trunk/rkward/packages/rkwarddev/R/rk.JS.var-class.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.JS.var-class.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.JS.var-class.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -46,7 +46,7 @@
setValidity("rk.JS.var", function(object){
# vars in this object must be of the same class
- sapply(object at vars, function(this.var){
+ sapply(slot(object, "vars"), function(this.var){
if(!inherits(this.var, "rk.JS.var")){
stop(simpleError("Slot 'vars' can only have a list of elements of class 'rk.JS.var'!"))
} else {}
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.connect.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.connect.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.connect.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -59,10 +59,10 @@
} else {}
# let's see if we need to extract IDs first
- client.id <- check.ID(client)
+ client.id <- check.ID(client, search.environment=TRUE)
governor.id <- check.ID(governor)
# if governor is an XML node but not <convert>, append ".state"
- if(inherits(governor, "XiMpLe.node")){
+ if(is.XiMpLe.node(governor)){
node.name <- slot(governor, "name")
if(!identical(node.name, "convert")){
# validate get modifier
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.convert.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.convert.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.convert.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -99,9 +99,9 @@
this.modif <- src.names[src.no]
valid.modif <- modif.validity(source=sources[[src.no]], modifier=this.modif, bool=FALSE)
if(nchar(valid.modif) > 0){
- new.value <- paste(check.ID(sources[[src.no]]), this.modif, sep=".")
+ new.value <- paste(check.ID(sources[[src.no]], search.environment=TRUE), this.modif, sep=".")
} else {
- new.value <- check.ID(sources[[src.no]])
+ new.value <- check.ID(sources[[src.no]], search.environment=TRUE)
}
return(new.value)
}))
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.entry.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.entry.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.entry.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -41,11 +41,8 @@
} else {}
# check the node names and allow only valid ones
- if(inherits(component, "XiMpLe.node")){
- node.name <- slot(component ,"name")
- if(!identical(node.name, "component")){
- stop(simpleError(paste0("Invalid XML node for 'entry': ", node.name)))
- } else {}
+ if(is.XiMpLe.node(component)){
+ valid.parent(parent="component", node=component, warn=FALSE, see="rk.XML.component")
} else {}
attr.list <- list(component=check.ID(component))
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.formula.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.formula.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.formula.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -42,7 +42,7 @@
rk.XML.formula <- function(fixed, dependent, id.name="auto"){
# check if these are actually varslots
sapply(list(fixed, dependent), function(this.attr){
- if(inherits(this.attr, "XiMpLe.node")){
+ if(is.XiMpLe.node(this.attr)){
this.attr.name <- slot(this.attr ,"name")
if(!identical(this.attr.name, "varslot")){
stop(simpleError(paste0("'fixed' and 'dependent' must be <varslot> nodes! You provided: <", this.attr.name, ">")))
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.insert.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.insert.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.insert.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -42,11 +42,8 @@
stop(simpleError("'snippet' must be of length 1!"))
} else {}
- if(inherits(snippet, "XiMpLe.node")){
- node.name <- slot(snippet, "name")
- if(!identical(node.name, "snippet")){
- stop(simpleError(paste0("Invalid XML node, must be a snippet: ", node.name)))
- } else {}
+ if(is.XiMpLe.node(snippet)){
+ valid.parent(parent="snippet", node=snippet, warn=FALSE, see="rk.XML.snippet")
} else {}
# let's see if we need to extract IDs first
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.option.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.option.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.option.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -17,6 +17,18 @@
#' Create XML node "option" for RKWard plugins
+#'
+#' @note You will rarely need this function, as options can be defined directly as a list
+#' in applicable functions like \code{\link[rkwarddev:rk.XML.radio]{rk.XML.radio}}. The main
+#' purpose for having this function is to set an ID for a particular option, e.g. to be able
+#' to hide it by logic rules.
+#'
+#' To address such an option in your logic section, the \code{id}
+#' you need is a combination of \code{<parent id>.<option id>}. That is,
+#' you must always prefix it with the parent's \code{id}. If you use the object
+#' an object generated by this function inside a parent node, both IDs will
+#' automatically be stored internally, so that the correct prefix will be added
+#' if needed whenever you apply logic rules to the option object.
#'
#' @param label Character string, a text label for this plugin element.
#' @param val Character string, defines the value to submit if the option is checked.
@@ -29,8 +41,10 @@
#' @examples
#' test.radio <- rk.XML.radio("Chose one",
#' options=list(
-#' rk.XML.option("First Option", val="val1"),
-#' rk.XML.option("Second Option", val="val2", chk=TRUE))
+#' "First Option"=c(val="val1", chk=TRUE),
+#' test.radio.opt2 <- rk.XML.option("Second Option", val="val2", id.name="auto"),
+#' "third Option"=c(val="val3"))
+#' )
#' cat(pasteXML(test.radio))
rk.XML.option <- function(label, val=NULL, chk=FALSE, id.name=NULL){
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.pluginmap.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.pluginmap.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.pluginmap.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -110,7 +110,7 @@
if(!is.null(require)){
# check if this is *really* require nodes
for(this.child in child.list(require)){
- if(inherits(this.child, "XiMpLe.node")){
+ if(is.XiMpLe.node(this.child)){
valid.parent("require", node=this.child, see="rk.XML.require")
all.children[[length(all.children)+1]] <- this.child
} else {
@@ -130,7 +130,7 @@
## components section
if(!is.null(components)){
- if(inherits(components, "XiMpLe.node")){
+ if(is.XiMpLe.node(components)){
# check if this is *really* a components section, otherwise quit and go dancing
valid.parent("components", node=components, see="rk.XML.components")
all.children[[length(all.children)+1]] <- components
@@ -173,7 +173,7 @@
} else {}
## hierachy section
- if(inherits(hierarchy, "XiMpLe.node")){
+ if(is.XiMpLe.node(hierarchy)){
# check if this is *really* a hierarchy section, otherwise quit and go dancing
valid.parent("hierarchy", node=hierarchy, see="rk.XML.hierarchy")
all.children[[length(all.children)+1]] <- hierarchy
@@ -256,7 +256,7 @@
## context sections
if(!is.null(x11.context)){
# check if this is *really* a context node for x11
- if(inherits(x11.context, "XiMpLe.node")){
+ if(is.XiMpLe.node(x11.context)){
node.name <- slot(x11.context, "name")
ctxt.name <- slot(x11.context, "attributes")$id
} else {
@@ -276,7 +276,7 @@
# import
if(!is.null(import.context)){
# check if this is *really* a context node for import
- if(inherits(import.context, "XiMpLe.node")){
+ if(is.XiMpLe.node(import.context)){
node.name <- slot(import.context, "name")
ctxt.name <- slot(import.context, "attributes")$id
} else {
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.radio.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.radio.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.radio.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -17,6 +17,9 @@
#' Create XML node "radio" for RKWard plugins
+#'
+#' @note It is also possible to address a particular option by giving it an ID, probably useful
+#' in logic sections. Have a look at \code{\link[rkwarddev:rk.XML.option]{rk.XML.option}} for details.
#'
#' @param label Character string, a text label for this plugin element.
#' @param options A named list with options to choose from. The names of the list elements will become
@@ -31,7 +34,9 @@
#' accordingly, too!
#' @return An object of class \code{XiMpLe.node}.
#' @export
-#' @seealso \href{help:rkwardplugins}{Introduction to Writing Plugins for RKWard}
+#' @seealso
+#' \code{\link[rkwarddev:rk.XML.option]{rk.XML.option}},
+#' \href{help:rkwardplugins}{Introduction to Writing Plugins for RKWard}
#' @examples
#' test.radio <- rk.XML.radio("Chose one",
#' options=list("First Option"=c(val="val1"),
@@ -39,9 +44,6 @@
#' cat(pasteXML(test.radio))
rk.XML.radio <- function(label, options=list(label=c(val=NULL, chk=FALSE)), id.name="auto", help=NULL, component=rk.get.comp()){
- # convert list elements into a list of XiMpLe nodes (if they aren't already)
- rd.options <- rk.check.options(options, parent="radio")
-
if(identical(id.name, "auto")){
id <- auto.ids(label, prefix=ID.prefix("radio"))
} else {
@@ -49,11 +51,17 @@
}
rd.attr.list <- list(id=id, label=label)
+ # convert list elements into a list of XiMpLe nodes (if they aren't already)
+ rd.options <- rk.check.options(options, parent="radio")
+
radio <- XMLNode("radio",
attrs=rd.attr.list,
.children=child.list(rd.options, empty=FALSE)
)
+ # if present, store option IDs with parent ID
+ rk.register.options(options, parent.node=radio)
+
# check for .rkh content
rk.set.rkh.prompter(component=component, id=id, help=help)
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.snippets.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.snippets.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.snippets.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -40,7 +40,7 @@
# check the node names and allow only valid ones
sapply(child.list(nodes), function(this.node){
- stopifnot(inherits(this.node, "XiMpLe.node"))
+ stopifnot(is.XiMpLe.node(this.node))
node.name <- slot(this.node, "name")
if(!node.name %in% c("snippet", "!--")){
stop(simpleError(paste0("Invalid XML nodes for snippets section: ", node.name)))
Modified: trunk/rkward/packages/rkwarddev/R/rk.XML.varslot.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.varslot.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.varslot.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -62,7 +62,7 @@
rk.XML.varslot <- function(label, source, required=FALSE, multi=FALSE, min=1, any=1, max=0,
dim=0, min.len=0, max.len=NULL, classes=NULL, types=NULL, id.name="auto", help=NULL, component=rk.get.comp()){
- if(inherits(source, "XiMpLe.node")){
+ if(is.XiMpLe.node(source)){
source.name <- slot(source, "name")
if(!identical(source.name, "varselector")){
stop(simpleError(paste0("'source' must be a <varselector> node! You provided: <", source.name, ">")))
Modified: trunk/rkward/packages/rkwarddev/R/rk.plugin.component.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.plugin.component.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.plugin.component.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -90,16 +90,12 @@
provides=c("logic", "dialog"), scan=c("var", "saveobj", "settings"), guess.getter=FALSE,
hierarchy="test", include=NULL, create=c("xml", "js", "rkh"), hints=TRUE, gen.info=TRUE, indent.by="\t"){
- if(inherits(about, "XiMpLe.node")){
- about.node.name <- slot(about, "name")
+ if(is.XiMpLe.node(about)){
# check if this is *really* a about section, otherwise quit and go dancing
- if(!identical(about.node.name, "about")){
- stop(simpleError("I don't know what this is, but 'about' is not an about section!"))
- } else {
- # fetch the plugin name
- name <- slot(about, "attributes")[["name"]]
- about.node <- about
- }
+ valid.parent(parent="about", node=about, warn=FALSE, see="rk.XML.about")
+ # fetch the plugin name
+ name <- XMLAttrs(about, "attributes")[["name"]]
+ about.node <- about
} else if(is.character(about) & length(about) == 1) {
name <- about
about.node <- NULL
Modified: trunk/rkward/packages/rkwarddev/R/rk.plugin.skeleton.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.plugin.skeleton.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.plugin.skeleton.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -162,7 +162,7 @@
components=list(), dependencies=NULL, edit=FALSE, load=FALSE, show=FALSE, gen.info=TRUE,
hints=TRUE, indent.by="\t", lang=rk.get.language()){
- if(inherits(about, "XiMpLe.node")){
+ if(is.XiMpLe.node(about)){
# check about and dependencies
# result is a named list with "about" and "dependencies"
about.dep.list <- dependenciesCompatWrapper(dependencies=dependencies, about=about, hints=hints)
Modified: trunk/rkward/packages/rkwarddev/R/rk.rkh.doc.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.rkh.doc.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.rkh.doc.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -58,7 +58,7 @@
if(!is.null(title)){
# check if this is *really* a title section
- if(inherits(title, "XiMpLe.node")){
+ if(is.XiMpLe.node(title)){
title.node.name <- slot(title, "name")
} else {
title.node.name <- "yougottabekiddingme"
@@ -71,7 +71,7 @@
if(!is.null(summary)){
# check if this is *really* a summary section
- if(inherits(summary, "XiMpLe.node")){
+ if(is.XiMpLe.node(summary)){
summary.node.name <- slot(summary, "name")
} else {
summary.node.name <- "yougottabekiddingme"
@@ -86,7 +86,7 @@
if(!is.null(usage)){
# check if this is *really* a usage section
- if(inherits(usage, "XiMpLe.node")){
+ if(is.XiMpLe.node(usage)){
usage.node.name <- slot(usage, "name")
} else {
usage.node.name <- "yougottabekiddingme"
@@ -102,7 +102,7 @@
if(!is.null(sections)){
for(this.section in sections){
# check if this is *really* a section
- if(inherits(this.section, "XiMpLe.node")){
+ if(is.XiMpLe.node(this.section)){
this.section.node.name <- slot(this.section, "name")
} else {
this.section.node.name <- "yougottabekiddingme"
@@ -120,7 +120,7 @@
if(!is.null(settings)){
# check if this is *really* a settings section
- if(inherits(settings, "XiMpLe.node")){
+ if(is.XiMpLe.node(settings)){
settings.node.name <- slot(settings, "name")
} else {
settings.node.name <- "yougottabekiddingme"
@@ -135,7 +135,7 @@
if(!is.null(related)){
# check if this is *really* a related section
- if(inherits(related, "XiMpLe.node")){
+ if(is.XiMpLe.node(related)){
related.node.name <- slot(related, "name")
} else {
related.node.name <- "yougottabekiddingme"
@@ -150,7 +150,7 @@
if(!is.null(technical)){
# check if this is *really* a technical section
- if(inherits(technical, "XiMpLe.node")){
+ if(is.XiMpLe.node(technical)){
technical.node.name <- slot(technical, "name")
} else {
technical.node.name <- "yougottabekiddingme"
Modified: trunk/rkward/packages/rkwarddev/R/rk.rkh.related.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.rkh.related.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.rkh.related.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -35,11 +35,8 @@
# check the node names and allow only valid ones
li.elements <- sapply(child.list(links), function(this.node){
- if(!identical(slot(this.node, "name"), "link")){
- stop(simpleError(paste0("Invalid XML nodes for links section: ", this.node at name)))
- } else {
- li.element <- XMLNode("li", .children=child.list(this.node, empty=FALSE))
- }
+ valid.parent(parent="link", node=this.node, warn=FALSE, see="rk.rkh.link")
+ li.element <- XMLNode("li", .children=child.list(this.node, empty=FALSE))
return(li.element)
})
Modified: trunk/rkward/packages/rkwarddev/R/rk.set.comp.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.set.comp.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.set.comp.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -30,6 +30,6 @@
rk.set.comp <- function(component=NULL){
rkh.prompter <- get.rkh.prompter()
rkh.prompter[[".active.component"]] <- component
- assign("rkh.prompter", rkh.prompter, envir=.rkdev.env)
+ set.rk.env("rkh.prompter", value=rkh.prompter)
return(invisible(NULL))
}
Modified: trunk/rkward/packages/rkwarddev/R/rk.set.language.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.set.language.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.set.language.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -36,12 +36,12 @@
} else {}
message(paste("removed language setting"))
} else {
- assign("lang", lang, envir=.rkdev.env)
+ set.rk.env("lang", value=lang)
message(paste("set language to:", dQuote(lang)))
if(is.null(locales)){
warning("please provide at least one locale!")
} else {
- assign("locales", locales, envir=.rkdev.env)
+ set.rk.env("locales", value=locales)
message(paste("set locales to:", paste0(dQuote(locales), collapse=", ")))
}
}
Modified: trunk/rkward/packages/rkwarddev/R/rk.set.rkh.prompter.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.set.rkh.prompter.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rk.set.rkh.prompter.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -70,6 +70,6 @@
rkh.prompter[[component]][[id]][["help"]] <- help
}
- assign("rkh.prompter", rkh.prompter, envir=.rkdev.env)
+ set.rk.env("rkh.prompter", rkh.prompter)
return(invisible(NULL))
}
Modified: trunk/rkward/packages/rkwarddev/R/rkwarddev-package.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rkwarddev-package.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/rkwarddev-package.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -4,7 +4,7 @@
#' Package: \tab rkwarddev\cr
#' Type: \tab Package\cr
#' Version: \tab 0.06-5\cr
-#' Date: \tab 2014-10-11\cr
+#' Date: \tab 2014-10-12\cr
#' Depends: \tab R (>= 2.9.0),methods,XiMpLe (>= 0.03-21),rkward (>= 0.5.7)\cr
#' Enhances: \tab rkward\cr
#' Encoding: \tab UTF-8\cr
Modified: trunk/rkward/packages/rkwarddev/R/tf.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/tf.R 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/R/tf.R 2014-10-12 13:19:06 UTC (rev 4895)
@@ -56,14 +56,7 @@
tf <- function(cbox, true=TRUE, not=FALSE, ifelse=FALSE, false=FALSE, opt=NULL, prefix=",\n", level=3, indent.by="\t"){
# check if we're given a checkbox, alright...
- if(inherits(cbox, "XiMpLe.node")){
- node.name <- cbox at name
- if(!identical(node.name, "checkbox")){
- stop(simpleError(paste0("Invalid XML node, expected 'checkbox' and got: ", node.name)))
- } else {}
- } else {
- stop(simpleError("'cbox' must be of class XiMpLe.node!"))
- }
+ valid.parent(parent="checkbox", node=cbox, warn=FALSE, see="rk.XML.cbox", arg.name="cbox")
if(is.null(opt)){
opt.name <- id(cbox, js=FALSE)
Modified: trunk/rkward/packages/rkwarddev/inst/doc/rkwarddev_vignette.pdf
===================================================================
(Binary files differ)
Modified: trunk/rkward/packages/rkwarddev/man/rk.XML.option.Rd
===================================================================
--- trunk/rkward/packages/rkwarddev/man/rk.XML.option.Rd 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/man/rk.XML.option.Rd 2014-10-12 13:19:06 UTC (rev 4895)
@@ -23,11 +23,26 @@
\description{
Create XML node "option" for RKWard plugins
}
+\note{
+You will rarely need this function, as options can be defined directly as a list
+in applicable functions like \code{\link[rkwarddev:rk.XML.radio]{rk.XML.radio}}. The main
+purpose for having this function is to set an ID for a particular option, e.g. to be able
+to hide it by logic rules.
+
+To address such an option in your logic section, the \code{id}
+you need is a combination of \code{<parent id>.<option id>}. That is,
+you must always prefix it with the parent's \code{id}. If you use the object
+an object generated by this function inside a parent node, both IDs will
+automatically be stored internally, so that the correct prefix will be added
+if needed whenever you apply logic rules to the option object.
+}
\examples{
test.radio <- rk.XML.radio("Chose one",
options=list(
- rk.XML.option("First Option", val="val1"),
- rk.XML.option("Second Option", val="val2", chk=TRUE))
+ "First Option"=c(val="val1", chk=TRUE),
+ test.radio.opt2 <- rk.XML.option("Second Option", val="val2", id.name="auto"),
+ "third Option"=c(val="val3"))
+)
cat(pasteXML(test.radio))
}
\seealso{
Modified: trunk/rkward/packages/rkwarddev/man/rk.XML.radio.Rd
===================================================================
--- trunk/rkward/packages/rkwarddev/man/rk.XML.radio.Rd 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/man/rk.XML.radio.Rd 2014-10-12 13:19:06 UTC (rev 4895)
@@ -33,6 +33,10 @@
\description{
Create XML node "radio" for RKWard plugins
}
+\note{
+It is also possible to address a particular option by giving it an ID, probably useful
+in logic sections. Have a look at \code{\link[rkwarddev:rk.XML.option]{rk.XML.option}} for details.
+}
\examples{
test.radio <- rk.XML.radio("Chose one",
options=list("First Option"=c(val="val1"),
@@ -40,6 +44,7 @@
cat(pasteXML(test.radio))
}
\seealso{
-\href{help:rkwardplugins}{Introduction to Writing Plugins for RKWard}
+\code{\link[rkwarddev:rk.XML.option]{rk.XML.option}},
+ \href{help:rkwardplugins}{Introduction to Writing Plugins for RKWard}
}
Modified: trunk/rkward/packages/rkwarddev/man/rkwarddev-package.Rd
===================================================================
--- trunk/rkward/packages/rkwarddev/man/rkwarddev-package.Rd 2014-10-11 20:40:23 UTC (rev 4894)
+++ trunk/rkward/packages/rkwarddev/man/rkwarddev-package.Rd 2014-10-12 13:19:06 UTC (rev 4895)
@@ -11,7 +11,7 @@
Package: \tab rkwarddev\cr
Type: \tab Package\cr
Version: \tab 0.06-5\cr
-Date: \tab 2014-10-11\cr
+Date: \tab 2014-10-12\cr
Depends: \tab R (>= 2.9.0),methods,XiMpLe (>= 0.03-21),rkward (>= 0.5.7)\cr
Enhances: \tab rkward\cr
Encoding: \tab UTF-8\cr
More information about the rkward-tracker
mailing list