[rkward-cvs] SF.net SVN: rkward:[3874] trunk/rkward
m-eik at users.sourceforge.net
m-eik at users.sourceforge.net
Sun Oct 2 17:05:44 UTC 2011
Revision: 3874
http://rkward.svn.sourceforge.net/rkward/?rev=3874&view=rev
Author: m-eik
Date: 2011-10-02 17:05:43 +0000 (Sun, 02 Oct 2011)
Log Message:
-----------
moved rkwarddev and XiMpLe from ./rkward/rbackend/rpackages/ to ./packages
Added Paths:
-----------
trunk/rkward/packages/
trunk/rkward/packages/XiMpLe/
trunk/rkward/packages/XiMpLe/ChangeLog
trunk/rkward/packages/XiMpLe/DESCRIPTION
trunk/rkward/packages/XiMpLe/NAMESPACE
trunk/rkward/packages/XiMpLe/R/
trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.R
trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.roxy.all.R
trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R
trunk/rkward/packages/XiMpLe/R/XiMpLe.doc-class.R
trunk/rkward/packages/XiMpLe/R/XiMpLe.node-class.R
trunk/rkward/packages/XiMpLe/R/node.R
trunk/rkward/packages/XiMpLe/R/parseXMLTree.R
trunk/rkward/packages/XiMpLe/R/pasteXMLNode.R
trunk/rkward/packages/XiMpLe/R/pasteXMLTag.R
trunk/rkward/packages/XiMpLe/R/pasteXMLTree.R
trunk/rkward/packages/XiMpLe/R/show.XiMpLe.doc.R
trunk/rkward/packages/XiMpLe/R/show.XiMpLe.node.R
trunk/rkward/packages/XiMpLe/inst/
trunk/rkward/packages/XiMpLe/inst/CITATION
trunk/rkward/packages/XiMpLe/man/
trunk/rkward/packages/XiMpLe/man/XiMpLe-package.Rd
trunk/rkward/packages/XiMpLe/man/XiMpLe.doc-class.Rd
trunk/rkward/packages/XiMpLe/man/XiMpLe.node-class.Rd
trunk/rkward/packages/XiMpLe/man/node.Rd
trunk/rkward/packages/XiMpLe/man/parseXMLTree.Rd
trunk/rkward/packages/XiMpLe/man/pasteXMLNode.Rd
trunk/rkward/packages/XiMpLe/man/pasteXMLTag.Rd
trunk/rkward/packages/XiMpLe/man/pasteXMLTree.Rd
trunk/rkward/packages/XiMpLe/man/show-methods.Rd
trunk/rkward/packages/rkwarddev/
trunk/rkward/packages/rkwarddev/ChangeLog
trunk/rkward/packages/rkwarddev/DESCRIPTION
trunk/rkward/packages/rkwarddev/NAMESPACE
trunk/rkward/packages/rkwarddev/R/
trunk/rkward/packages/rkwarddev/R/rk-internal.R
trunk/rkward/packages/rkwarddev/R/rk.JS.array.R
trunk/rkward/packages/rkwarddev/R/rk.JS.doc.R
trunk/rkward/packages/rkwarddev/R/rk.JS.scan.R
trunk/rkward/packages/rkwarddev/R/rk.XML.about.R
trunk/rkward/packages/rkwarddev/R/rk.XML.attribute.R
trunk/rkward/packages/rkwarddev/R/rk.XML.browser.R
trunk/rkward/packages/rkwarddev/R/rk.XML.cbox.R
trunk/rkward/packages/rkwarddev/R/rk.XML.col.R
trunk/rkward/packages/rkwarddev/R/rk.XML.component.R
trunk/rkward/packages/rkwarddev/R/rk.XML.components.R
trunk/rkward/packages/rkwarddev/R/rk.XML.connect.R
trunk/rkward/packages/rkwarddev/R/rk.XML.context.R
trunk/rkward/packages/rkwarddev/R/rk.XML.convert.R
trunk/rkward/packages/rkwarddev/R/rk.XML.copy.R
trunk/rkward/packages/rkwarddev/R/rk.XML.dialog.R
trunk/rkward/packages/rkwarddev/R/rk.XML.dropdown.R
trunk/rkward/packages/rkwarddev/R/rk.XML.embed.R
trunk/rkward/packages/rkwarddev/R/rk.XML.entry.R
trunk/rkward/packages/rkwarddev/R/rk.XML.external.R
trunk/rkward/packages/rkwarddev/R/rk.XML.formula.R
trunk/rkward/packages/rkwarddev/R/rk.XML.frame.R
trunk/rkward/packages/rkwarddev/R/rk.XML.hierarchy.R
trunk/rkward/packages/rkwarddev/R/rk.XML.include.R
trunk/rkward/packages/rkwarddev/R/rk.XML.input.R
trunk/rkward/packages/rkwarddev/R/rk.XML.insert.R
trunk/rkward/packages/rkwarddev/R/rk.XML.logic.R
trunk/rkward/packages/rkwarddev/R/rk.XML.menu.R
trunk/rkward/packages/rkwarddev/R/rk.XML.page.R
trunk/rkward/packages/rkwarddev/R/rk.XML.plugin.R
trunk/rkward/packages/rkwarddev/R/rk.XML.pluginmap.R
trunk/rkward/packages/rkwarddev/R/rk.XML.preview.R
trunk/rkward/packages/rkwarddev/R/rk.XML.radio.R
trunk/rkward/packages/rkwarddev/R/rk.XML.require.R
trunk/rkward/packages/rkwarddev/R/rk.XML.row.R
trunk/rkward/packages/rkwarddev/R/rk.XML.saveobj.R
trunk/rkward/packages/rkwarddev/R/rk.XML.set.R
trunk/rkward/packages/rkwarddev/R/rk.XML.snippet.R
trunk/rkward/packages/rkwarddev/R/rk.XML.snippets.R
trunk/rkward/packages/rkwarddev/R/rk.XML.spinbox.R
trunk/rkward/packages/rkwarddev/R/rk.XML.stretch.R
trunk/rkward/packages/rkwarddev/R/rk.XML.tabbook.R
trunk/rkward/packages/rkwarddev/R/rk.XML.text.R
trunk/rkward/packages/rkwarddev/R/rk.XML.vars.R
trunk/rkward/packages/rkwarddev/R/rk.XML.varselector.R
trunk/rkward/packages/rkwarddev/R/rk.XML.varslot.R
trunk/rkward/packages/rkwarddev/R/rk.XML.wizard.R
trunk/rkward/packages/rkwarddev/R/rk.build.plugin.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.scan.R
trunk/rkward/packages/rkwarddev/R/rk.testsuite.doc.R
trunk/rkward/packages/rkwarddev/R/rkwarddev-desc-internal.R
trunk/rkward/packages/rkwarddev/R/rkwarddev-package.R
trunk/rkward/packages/rkwarddev/inst/
trunk/rkward/packages/rkwarddev/inst/CITATION
trunk/rkward/packages/rkwarddev/man/
trunk/rkward/packages/rkwarddev/man/rk.JS.array.Rd
trunk/rkward/packages/rkwarddev/man/rk.JS.doc.Rd
trunk/rkward/packages/rkwarddev/man/rk.JS.scan.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.about.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.attribute.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.browser.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.cbox.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.col.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.component.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.components.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.connect.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.context.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.convert.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.copy.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.dialog.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.dropdown.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.embed.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.entry.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.external.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.formula.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.frame.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.hierarchy.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.include.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.input.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.insert.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.logic.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.menu.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.page.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.plugin.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.pluginmap.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.preview.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.radio.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.require.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.row.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.saveobj.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.set.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.snippet.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.snippets.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.spinbox.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.stretch.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.tabbook.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.text.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.vars.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.varselector.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.varslot.Rd
trunk/rkward/packages/rkwarddev/man/rk.XML.wizard.Rd
trunk/rkward/packages/rkwarddev/man/rk.build.plugin.Rd
trunk/rkward/packages/rkwarddev/man/rk.plugin.skeleton.Rd
trunk/rkward/packages/rkwarddev/man/rk.rkh.doc.Rd
trunk/rkward/packages/rkwarddev/man/rk.rkh.scan.Rd
trunk/rkward/packages/rkwarddev/man/rk.testsuite.doc.Rd
trunk/rkward/packages/rkwarddev/man/rkwarddev-package.Rd
Added: trunk/rkward/packages/XiMpLe/ChangeLog
===================================================================
--- trunk/rkward/packages/XiMpLe/ChangeLog (rev 0)
+++ trunk/rkward/packages/XiMpLe/ChangeLog 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,60 @@
+ChangeLog for package XiMpLe
+
+## 0.03-4 (2011-10-01)
+ - added show methods for objects of class XiMpLe.doc and XiMpLe.node
+
+## 0.03-3 (2011-09-27)
+ - changed default 'shine' value of pasteXMLNode() and pasteXMLTree() from 2 to 1
+ - pasteXMLNode() and pasteXMLTree() now try to call each other if fed with the wrong class object,
+ but a warning is given
+ - changed handling of 'value' in pasteXMLNode(), now reflects 'shine' setting/indentation
+
+## 0.03-2 (2011-09-17)
+ - added docs for classed XiMpLe.doc and XiMpLe.node
+
+## 0.03-1 (2011-09-11)
+ - fixed outstanding issue with complex value structures
+ - changed "Author at R" to "Authors at R" in DESCRIPTION (for R >= 2.14)
+
+## 0.02-2 (2011-09-01)
+ - fixed missing "methods" dependecy
+ - adjusted docs a little
+
+## 0.02-1 (2011-08-30)
+ - added option "indent.by" to the paste functions, in case one prefers space over tab.
+ - moved all rk.* functions out of this package and into its own (rkwardplugdev)
+
+## 0.01-9 (2011-08-28)
+ - tiny improvements to XML formatting
+ - added functions rk.XML.tabbook(), rk.XML.dropdown(), rk.XML.plugin()
+ rk.XML.pluginmap() and rk.plugin.skeleton() [to be moved again]
+
+## 0.01-8 (2011-08-26)
+ - improved handling of comments a lot
+
+## 0.01-7 (2011-08-24)
+ - fixed typo bug in XML.single.tags()
+ - improved support for comments and CDATA
+ - improved XML formatting
+
+## 0.01-6 (2011-08-23)
+ - added functions pasteXMLTree() and pasteXMLNode()
+ - added validity checks for classes XiMpLe.doc and XiMpLe.node
+ - added function rk.XML.about() [which will probably be moved out of the package]
+
+## 0.01-5 (2011-08-22)
+ - writing new node values with node<-() partly works
+
+## 0.01-4 (2011-08-21)
+ - rewrote and renamed getNode() to node()
+
+## 0.01-3 (2011-08-18)
+ - checks XML and DTD declaration now
+ - added getNode() method
+
+## 0.01-2 (2011-08-15)
+ - iterating through an XML tree actually works now
+
+## 0.01-1 (2011-08-14)
+ - initial release via reaktanz.de
+
\ No newline at end of file
Added: trunk/rkward/packages/XiMpLe/DESCRIPTION
===================================================================
--- trunk/rkward/packages/XiMpLe/DESCRIPTION (rev 0)
+++ trunk/rkward/packages/XiMpLe/DESCRIPTION 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,36 @@
+Package: XiMpLe
+Type: Package
+Title: A simple XML tree parser and generator
+Author: m.eik michalke <meik.michalke at hhu.de>
+Maintainer: m.eik michalke <meik.michalke at hhu.de>
+Depends:
+ R (>= 2.9.0),methods
+Enhances: rkward
+Description: This package provides a simple XML tree
+ parser/generator. It includes functions to read XML
+ files into R objects, get information out of and into
+ nodes, and write R objects back to XML code. It's not
+ as powerful as the XML package and doesn't aim to be,
+ but for simple XML handling it could be useful. It was
+ originally programmed for RKWard.
+License: GPL (>= 3)
+Encoding: UTF-8
+LazyLoad: yes
+URL: http://rkward.sourceforge.net
+Authors at R: c(person(given="Meik", family="Michalke",
+ email="meik.michalke at hhu.de", role=c("aut", "cre")))
+Version: 0.03-4
+Date: 2011-10-01
+Collate:
+ 'XiMpLe.node-class.R'
+ 'XiMpLe.doc-class.R'
+ 'node.R'
+ 'parseXMLTree.R'
+ 'pasteXMLNode.R'
+ 'pasteXMLTag.R'
+ 'pasteXMLTree.R'
+ 'show.XiMpLe.doc.R'
+ 'show.XiMpLe.node.R'
+ 'XiMpLe-internal.R'
+ 'XiMpLe-internal.roxy.all.R'
+ 'XiMpLe-package.R'
Added: trunk/rkward/packages/XiMpLe/NAMESPACE
===================================================================
--- trunk/rkward/packages/XiMpLe/NAMESPACE (rev 0)
+++ trunk/rkward/packages/XiMpLe/NAMESPACE 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,10 @@
+exportClasses(XiMpLe.doc)
+exportClasses(XiMpLe.node)
+exportMethods(node)
+exportMethods("node<-")
+exportMethods(show)
+export(parseXMLTree)
+export(pasteXMLNode)
+export(pasteXMLTag)
+export(pasteXMLTree)
+import(methods)
Added: trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,436 @@
+## internal functions, not exported
+
+## function XML.single.tags()
+# Splits one character string or vector with an XML tree into a vector with its single tags.
+# - tree: The XML tree, must be character.
+# - drop: A character vector with the possible contens \code{c("comments","declarations","cdata","value")}
+XML.single.tags <- function(tree, drop=NULL){
+ if(!is.character(tree)){
+ stop(simpleError("'tree' must be character!"))
+ } else {}
+ if(length(tree) > 1) {
+ # force tree into one string
+ tree <- paste(tree, collapse="")
+ } else {}
+ # remove space at beginning (and end)
+ tree <- trim(tree)
+
+ ## the main splitting process
+ # CDATA or comments can contain stuff which might ruin the outcome. we'll deal with those parts first.
+ # this solution is perhaps a little too complex... it should rarely be needed, though
+ special.treatment <- list(cdata=NULL, comments=NULL)
+ if(grepl("<!\\[CDATA\\[(.*)>(.*)\\]\\]>", tree)){
+ special.treatment[["cdata"]] <- c(split.start="<!\\[CDATA\\[", split.end="\\]\\]>", prefix="<![CDATA[", suffix="]]>")
+ } else {}
+ if(grepl("<!--(.*)>(.*)-->", tree)){
+ special.treatment[["comments"]] <- c(split.start="<!--", split.end="-->", prefix="<!--", suffix="-->")
+ } else {}
+ if(any(!sapply(special.treatment, is.null))){
+ for (treat.this in special.treatment){
+ # skip NULL entries
+ ifelse(is.null(treat.this), next, TRUE)
+ # steps are as follows, to be sure:
+ # - cut stream at beginning CDATA/comment entries
+ cut.trees <- unlist(strsplit(tree, split=treat.this[["split.start"]]))
+ # - re-add the cut-off CDATA/comment start
+ got.cut <- grep(treat.this[["split.end"]], cut.trees)
+ cut.trees[got.cut] <- paste(treat.this[["prefix"]], cut.trees[got.cut], sep="")
+ # - cut stream at ending CDATA/comment entries
+ cut.trees <- unlist(strsplit(cut.trees, split=treat.this[["split.end"]]))
+ # - re-add the cut-off CDATA/comment ending
+ got.cut <- grep(treat.this[["split.start"]], cut.trees)
+ cut.trees[got.cut] <- paste(cut.trees[got.cut], treat.this[["suffix"]], sep="")
+ }
+ # now do the splitting
+ single.tags <- unlist(sapply(cut.trees, function(this.tree){
+ if(
+ (!is.null(special.treatment[["cdata"]]) & grepl("<!\\[CDATA\\[", this.tree)) |
+ (!is.null(special.treatment[["comments"]]) & grepl("<!--", this.tree))
+ ) {
+ split.me <- FALSE
+ } else {
+ split.me <- TRUE
+ }
+ if(isTRUE(split.me)){
+ return(paste(unlist(strsplit(trim(this.tree), split=">[[:space:]]*")), ">", sep=""))
+ } else {
+ return(this.tree)
+ }
+ }))
+ } else {
+ single.tags <- paste(unlist(strsplit(tree, split=">[[:space:]]*")), ">", sep="")
+ }
+ # if there's values between tags, they do now precede them
+ has.value <- grepl("^[^<]", single.tags)
+ if(any(has.value)){
+ # each fix will add an entry, so we must correct for that
+ already.fixed <- 0
+ for (needs.split in which(has.value)){
+ tags.length <- length(single.tags)
+ split.me <- unlist(strsplit(single.tags[needs.split + already.fixed], split="[[:space:]]*<"))
+ if(length(split.me) != 2){ # malformated XML?
+ stop(simpleError(paste("Ouch, choking on input... malformatted XML? Don't know how to handle this:\n ", single.tags[needs.split + already.fixed], sep="")))
+ } else {}
+ # return the cut of "<"
+ split.me[2] <- paste("<", split.me[2], sep="")
+ if("value" %in% drop){
+ single.tags[needs.split + already.fixed] <- split.me[2]
+ } else {
+ single.tags <- c(single.tags[1:(needs.split + already.fixed - 1)], split.me, single.tags[(needs.split + already.fixed + 1):tags.length])
+ }
+ already.fixed <- already.fixed + 1
+ }
+ } else {}
+ if("comments" %in% drop){
+ single.tags <- single.tags[!XML.comment(single.tags)]
+ } else {}
+ if("declarations" %in% drop){
+ single.tags <- single.tags[!XML.declaration(single.tags)]
+ } else {}
+ if("doctype" %in% drop){
+ single.tags <- single.tags[!XML.doctype(single.tags)]
+ } else {}
+ if("cdata" %in% drop){
+ single.tags <- single.tags[!XML.cdata(single.tags)]
+ } else {}
+ return(single.tags)
+} ## end function XML.single.tags()
+
+## function indent()
+# will create tabs to format the output
+indent <- function(level, by="\t"){
+ paste(rep(by, level-1), collapse="")
+} ## end function indent()
+
+## function lookupAttrName()
+# takes the original input element names and returns
+# the according XML attribute name
+lookupAttrName <- function(tag, attr, rename){
+ if(is.null(tag)){
+ attr.name <- attr
+ } else {
+ attr.name <- rename[[tag]][[attr]]
+ }
+ return(attr.name)
+} ## end function lookupAttrName()
+
+## function pasteXMLAttr()
+# pastes all attributes in a nicely readable way
+pasteXMLAttr <- function(attr=NULL, tag=NULL, level=1, rename=NULL, shine=2, indent.by="\t"){
+ if(is.null(attr)){
+ return("")
+ } else {}
+
+ new.indent <- ifelse(shine > 1, indent(level+1, by=indent.by), "")
+ new.attr <- ifelse(shine > 1, "\n", " ")
+
+ # only use formatting if more than one attribute
+ if(length(attr) > 1){
+ full.attr <- c()
+ for (this.attr in names(attr)){
+ # skip empty elements
+ if(is.null(attr[[this.attr]])){next}
+ if(nchar(attr[[this.attr]]) > 0){
+ if(!is.null(rename)){
+ # look up attribute name to paste
+ attr.name <- lookupAttrName(tag, this.attr, rename=rename)
+ } else {
+ attr.name <- this.attr
+ }
+ full.attr <- trim(paste(full.attr, new.attr, new.indent, attr.name, "=\"", attr[[this.attr]], "\"", sep=""))
+ } else {}
+ }
+ } else {
+ if(!is.null(rename)){
+ # look up attribute name to paste
+ attr.name <- lookupAttrName(tag, names(attr), rename=rename)
+ } else {
+ attr.name <- names(attr)
+ }
+ # look up attribute name to paste
+ full.attr <- paste(attr.name, "=\"", attr[[1]], "\"", sep="")
+ }
+ return(full.attr)
+} ## end function pasteXMLAttr()
+
+## function parseXMLAttr()
+# takes a whole XML tag and returns a named list with its attributes
+parseXMLAttr <- function(tag){
+ if(XML.doctype(tag)){
+ stripped.tag <- gsub("<!((?i)DOCTYPE)[[:space:]]+([^[:space:]]+)[[:space:]]*([^\"[:space:]]*)[[:space:]]*.*>",
+ "doctype=\"\\2\", id=\"\\3\"", tag)
+ stripped.tag2 <- eval(parse(text=paste("c(",gsub("[^\"]*[\"]?([^\"]*)[\"]?[^\"]*", "\"\\1\",", tag),"NULL)")))
+ is.dtd <- grepl("\\.dtd", stripped.tag2)
+ doct.decl <- ifelse(sum(!is.dtd) > 0, paste(stripped.tag2[!is.dtd][1], sep=""), paste("", sep=""))
+ doct.ref <- ifelse(sum(is.dtd) > 0, paste(stripped.tag2[is.dtd][1], sep=""), paste("", sep=""))
+ parsed.list <- eval(parse(text=paste("list(", stripped.tag, ", decl=\"", doct.decl,"\"", ", refer=\"", doct.ref,"\")", sep="")))
+ } else if(XML.endTag(tag) | XML.comment(tag) |XML.cdata(tag)){
+ # end tags, comments and CDATA don't have attributes
+ parsed.list <- ""
+ } else {
+ # first strip of start and end characters
+ stripped.tag <- gsub("<([?[:space:]]*)[^[:space:]]+[[:space:]]*(.*)", "\\2", tag, perl=TRUE)
+ stripped.tag <- gsub("[/?]*>$", "", stripped.tag, perl=TRUE)
+ # fill in commas, so we can evaluate this as elements of a named list
+ separated.tag <- gsub("=[[:space:]]*\"([^\"]*)\"[[:space:]]+([^[:space:]=]+)", "=\"\\1\", \\2", stripped.tag, perl=TRUE)
+ parsed.list <- eval(parse(text=paste("list(", separated.tag, ")")))
+ }
+ if(XML.declaration(tag)){
+ valid.attr <- c("version", "encoding", "standalone")
+ parsed.list <- parsed.list[tolower(names(parsed.list)) %in% valid.attr]
+ for (miss.attr in valid.attr[!valid.attr %in% tolower(names(parsed.list))]){
+ parsed.list[[miss.attr]] <- ""
+ }
+ } else {}
+
+ return(parsed.list)
+} ## end function parseXMLAttr()
+
+## function trim()
+# cuts off space at start and end of a character string
+trim <- function(char){
+ char <- gsub("^[[:space:]]*", "", char)
+ char <- gsub("[[:space:]]*$", "", char)
+ return(char)
+} ## end function trim()
+
+## function XML.emptyTag()
+# checks if a tag is a pair of start/end tags or an empty tag;
+# returns either TRUE/FALSE, or the tag name if it is an empty tag and get=TRUE
+XML.emptyTag <- function(tag, get=FALSE){
+ empty.tags <- sapply(tag, function(this.tag){
+ empty <- grepl("/>$", this.tag)
+ if(isTRUE(get)){
+ result <- ifelse(isTRUE(empty), XML.tagName(this.tag), "")
+ } else {
+ result <- empty
+ }
+ return(result)
+ })
+ names(empty.tags) <- NULL
+ return(empty.tags)
+} ## end function XML.emptyTag()
+
+## function XML.endTag()
+# checks if a tag an end tag;
+# returns either TRUE/FALSE, or the tag name if it is an end tag and get=TRUE
+XML.endTag <- function(tag, get=FALSE){
+ end.tags <- sapply(tag, function(this.tag){
+ end <- grepl("^</", this.tag)
+ if(isTRUE(get)){
+ result <- ifelse(isTRUE(end), XML.tagName(this.tag), "")
+ } else {
+ result <- end
+ }
+ return(result)
+ })
+ names(end.tags) <- NULL
+ return(end.tags)
+} ## end function XML.endTag()
+
+## function XML.comment()
+# checks if a tag is a comment, returns TRUE or FALSE, or the comment (TRUE & get=TRUE)
+XML.comment <- function(tag, get=FALSE, trim=TRUE){
+ comment.tags <- sapply(tag, function(this.tag){
+ comment <- grepl("<!--(.*)-->", this.tag)
+ if(isTRUE(get)){
+ result <- ifelse(isTRUE(comment), gsub("<!--(.*)-->", "\\1", this.tag, perl=TRUE), "")
+ if(isTRUE(trim)){result <- trim(result)} else {}
+ } else {
+ result <- comment
+ }
+ return(result)
+ })
+ names(comment.tags) <- NULL
+ return(comment.tags)
+} ## end function XML.comment()
+
+## function XML.cdata()
+# checks if a tag is a CDATA declaration, returns TRUE or FALSE, or the data (TRUE & get=TRUE)
+XML.cdata <- function(tag, get=FALSE, trim=TRUE){
+ cdata.tags <- sapply(tag, function(this.tag){
+ cdata <- grepl("<!\\[CDATA\\[(.*)\\]\\]>", this.tag)
+ if(isTRUE(get)){
+ result <- ifelse(isTRUE(cdata), gsub("<!\\[CDATA\\[(.*)\\]\\]>", "\\1", this.tag, perl=TRUE), "")
+ if(isTRUE(trim)){result <- trim(result)} else {}
+ } else {
+ result <- cdata
+ }
+ return(result)
+ })
+ names(cdata.tags) <- NULL
+ return(cdata.tags)
+} ## end function XML.cdata()
+
+## function XML.value()
+# checks if 'tag' is actually not a tag but value/content/data. returns TRUE or FALSE, or the value (TRUE & get=TRUE)
+XML.value <- function(tag, get=FALSE, trim=TRUE){
+ all.values <- sapply(tag, function(this.tag){
+ value <- grepl("^[[:space:]]*[^<]", this.tag)
+ if(isTRUE(get)){
+ result <- ifelse(isTRUE(value), this.tag, "")
+ if(isTRUE(trim)){result <- trim(result)} else {}
+ } else {
+ result <- value
+ }
+ return(result)
+ })
+ names(all.values) <- NULL
+ return(all.values)
+} ## end function XML.value()
+
+## function XML.declaration()
+# checks for a declaration, like <?xml bar?>
+XML.declaration <- function(tag, get=FALSE){
+ decl.tags <- sapply(tag, function(this.tag){
+ declaration <- grepl("<\\?((?i)xml).*\\?>", this.tag, perl=TRUE)
+ if(isTRUE(get)){
+ result <- ifelse(isTRUE(declaration), XML.tagName(this.tag), "")
+ } else {
+ result <- declaration
+ }
+ return(result)
+ })
+ names(decl.tags) <- NULL
+ return(decl.tags)
+} ## end function XML.declaration()
+
+## function XML.doctype()
+# checks for a doctype declaration, like <!DOCTYPE foo>
+XML.doctype <- function(tag, get=FALSE){
+ decl.tags <- sapply(tag, function(this.tag){
+ declaration <- grepl("<!((?i)DOCTYPE).*>", this.tag, perl=TRUE)
+ if(isTRUE(get)){
+ result <- ifelse(isTRUE(declaration), XML.tagName(this.tag), "")
+ } else {
+ result <- declaration
+ }
+ return(result)
+ })
+ names(decl.tags) <- NULL
+ return(decl.tags)
+} ## end function XML.doctype()
+
+## function XML.def()
+XML.def <- function(tag, get=FALSE){
+ decl.tags <- sapply(tag, function(this.tag){
+ declaration <- grepl("<[!?]+[^-]*>", this.tag)
+ if(isTRUE(get)){
+ result <- ifelse(isTRUE(declaration), XML.tagName(this.tag), "")
+ } else {
+ result <- declaration
+ }
+ return(result)
+ })
+ names(decl.tags) <- NULL
+ return(decl.tags)
+} ## end function XML.def()
+
+## function XML.tagName()
+XML.tagName <- function(tag){
+ tag.names <- sapply(tag, function(this.tag){
+ tagName <- gsub("<([[:space:]!?/]*)([^[:space:]>]+).*", "\\2", this.tag, perl=TRUE)
+ return(tagName)
+ })
+ names(tag.names) <- NULL
+ return(tag.names)
+} ## end function XML.tagName()
+
+## function parseXMLTag()
+parseXMLTag <- function(tag){
+ tag.name <- XML.tagName(tag)
+ tag.attr <- parseXMLAttr(tag)
+ if(!is.null(tag.attr)){
+ parsed.tag <- list()
+ parsed.tag[[tag.name]] <- list(attr=tag.attr)
+ } else {
+ parsed.tag <- list()
+ parsed.tag[[tag.name]] <- list()
+ }
+ return(parsed.tag)
+} ## end function parseXMLTag()
+
+## function XML.nodes()
+XML.nodes <- function(single.tags, end.here=NA, start=1){
+ # try to iterate through the single tags
+ children <- list()
+ tag.no <- start
+ ## uncomment to debug:
+ # cat(start,"\n")
+ while (tag.no < length(single.tags)){
+ ## uncomment to debug:
+ # time.spent <- system.time({
+ this.tag <- single.tags[tag.no]
+ nxt.child <- length(children) + 1
+ child.name <- XML.tagName(this.tag)
+ child.end.tag <- paste("</[[:space:]]*", end.here,"[[:space:]>]+.*", sep="")
+ if(isTRUE(grepl(child.end.tag, this.tag))){
+ ## uncomment to debug:
+ # cat(this.tag, ": break (",tag.no,")\n")
+ break
+ } else {}
+ if(XML.value(this.tag)){
+ children[nxt.child] <- new("XiMpLe.node",
+ name="",
+ value=XML.value(this.tag, get=TRUE))
+ names(children)[nxt.child] <- "!value!"
+ tag.no <- tag.no + 1
+ next
+ } else {
+ child.attr <- parseXMLAttr(this.tag)
+ }
+ if(XML.declaration(this.tag)){
+ children[nxt.child] <- new("XiMpLe.node",
+ name=child.name,
+ attributes=child.attr)
+ names(children)[nxt.child] <- child.name
+ tag.no <- tag.no + 1
+ next
+ } else {}
+ if(XML.comment(this.tag)){
+ children[nxt.child] <- new("XiMpLe.node",
+ name="!--",
+ value=XML.comment(this.tag, get=TRUE))
+ names(children)[nxt.child] <- "!--"
+ tag.no <- tag.no + 1
+ next
+ } else {}
+ if(XML.cdata(this.tag)){
+ children[nxt.child] <- new("XiMpLe.node",
+ name="![CDATA[",
+ value=XML.cdata(this.tag, get=TRUE))
+ names(children)[nxt.child] <- "![CDATA["
+ tag.no <- tag.no + 1
+ next
+ } else {}
+ if(XML.endTag(this.tag)){
+ break
+ } else {}
+ if(!XML.emptyTag(this.tag)){
+ ## uncomment to debug:
+ # cat(child.name, ":", tag.no, "-", child.end.tag,"\n")
+ rec.nodes <- XML.nodes(single.tags, end.here=child.name, start=tag.no + 1)
+ children[nxt.child] <- new("XiMpLe.node",
+ name=child.name,
+ attributes=child.attr,
+ children=rec.nodes$children,
+ # this value will force the node to remain non-empty if it had no children,
+ # it would be turned into an empty tag otherwise
+ value="")
+ names(children)[nxt.child] <- child.name
+ tag.no <- rec.nodes$tag.no + 1
+ next
+ } else {
+ children[nxt.child] <- new("XiMpLe.node",
+ name=child.name,
+ attributes=child.attr)
+ names(children)[nxt.child] <- child.name
+ tag.no <- tag.no + 1
+ next
+ }
+ ## uncomment to debug:
+ # })
+ # cat("system.time:", time.spent, "\n")
+ }
+ return(list(children=children, tag.no=tag.no))
+} ## end function XML.nodes()
Added: trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.roxy.all.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.roxy.all.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.roxy.all.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,22 @@
+# package description files
+# this internal object can be used by the package roxyPackage to
+# automatically create/update DESCRIPTION and CITATION files
+pckg.dscrptn <- data.frame(
+ Package="XiMpLe",
+ Type="Package",
+ Title="A simple XML tree parser and generator",
+ Author="m.eik michalke <meik.michalke at hhu.de>",
+ AuthorsR="c(person(given=\"Meik\", family=\"Michalke\", email=\"meik.michalke at hhu.de\",
+ role=c(\"aut\", \"cre\")))",
+ Maintainer="m.eik michalke <meik.michalke at hhu.de>",
+ Depends="R (>= 2.9.0),methods",
+ Enhances="rkward",
+ Description="This package provides a simple XML tree parser/generator. It includes functions to read XML files into R objects,
+ get information out of and into nodes, and write R objects back to XML code.
+ It's not as powerful as the XML package and doesn't aim to be, but for simple XML handling
+ it could be useful. It was originally programmed for RKWard.",
+ License="GPL (>= 3)",
+ Encoding="UTF-8",
+ LazyLoad="yes",
+ URL="http://rkward.sourceforge.net",
+ stringsAsFactors=FALSE)
Added: trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,28 @@
+#' A simple XML tree parser and generator.
+#'
+#' \tabular{ll}{
+#' Package: \tab XiMpLe\cr
+#' Type: \tab Package\cr
+#' Version: \tab 0.03-4\cr
+#' Date: \tab 2011-10-01\cr
+#' Depends: \tab R (>= 2.9.0),methods\cr
+#' Enhances: \tab rkward\cr
+#' Encoding: \tab UTF-8\cr
+#' License: \tab GPL (>= 3)\cr
+#' LazyLoad: \tab yes\cr
+#' URL: \tab http://rkward.sourceforge.net\cr
+#' }
+#'
+#' This package provides a simple XML tree parser/generator. It includes functions to read XML files into R objects,
+#' get information out of and into nodes, and write R objects back to XML code.
+#' It's not as powerful as the XML package and doesn't aim to be, but for simple XML handling
+#' it could be useful. It was originally programmed for RKWard.
+#'
+#' @aliases XiMpLe-package XiMpLe
+#' @name XiMpLe-package
+#' @docType package
+#' @title A simple XML tree parser and generator.
+#' @author m.eik michalke \email{meik.michalke@@hhu.de}
+#' @keywords package
+roxygen <- function() NULL
+roxygen()
Added: trunk/rkward/packages/XiMpLe/R/XiMpLe.doc-class.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe.doc-class.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe.doc-class.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,65 @@
+## temporarily turned off most of the roxygen comments
+## class docs will remain static until roxygen2 supports "@slot"
+
+# Class XiMpLe.doc
+#
+# This class is used for objects that are returned by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
+#
+# @title S4 class XiMpLe.doc
+# @slot file Name of the file.
+# @slot xml XML declaration of the file.
+# @slot dtd Doctype definition of the file.
+# @slot children A list of objects of class XiMpLe.node, representing the DOM structure of the XML document.
+# @name XiMpLe.doc,-class
+# @aliases XiMpLe.doc-class XiMpLe.doc,-class
+#' @include XiMpLe.node-class.R
+#' @import methods
+# @keywords classes
+#' @noRd
+# @rdname XiMpLe.doc-class
+# @exportClass XiMpLe.doc
+#' @export
+
+setClass("XiMpLe.doc",
+ representation=representation(
+ file="character",
+ xml="list",
+ dtd="list",
+ children="list"
+ ),
+ prototype(
+ file=character(),
+ xml=list(),
+ dtd=list(),
+ children=list()
+ )
+)
+
+setValidity("XiMpLe.doc", function(object){
+ obj.xml <- object at xml
+ obj.dtd <- object at dtd
+ obj.children <- object at children
+
+ obj.xml.names <- names(obj.xml)
+ obj.dtd.names <- names(obj.dtd)
+ # if there are declarations, check that they all have names
+ if(length(obj.xml) > 0){
+ if(length(obj.xml) != length(obj.xml.names)){
+ stop(simpleError("Invalid object: All xml declarations must have names!"))
+ } else {}
+ } else {}
+ if(length(obj.dtd) > 0){
+ if(length(obj.dtd) != length(obj.dtd.names)){
+ stop(simpleError("Invalid object: All doctype declarations must have names!"))
+ } else {}
+ } else {}
+
+ # check content of children
+ if(length(obj.children) > 0){
+ child.nodes <- sapply(obj.children, function(this.child){inherits(this.child, "XiMpLe.node")})
+ if(!all(child.nodes)){
+ stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
+ } else {}
+ } else {}
+ return(TRUE)
+})
Added: trunk/rkward/packages/XiMpLe/R/XiMpLe.node-class.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe.node-class.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe.node-class.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,71 @@
+# Class XiMpLe.node
+#
+# This class is used to create DOM trees of XML documents, like objects that are returned
+# by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
+#
+# There are certain special values predefined for the \code{name} slot to easily create special XML elements:
+# \describe{
+# \item{\code{name=""}}{If the name is an empty character string, a pseudo node is created,
+# \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}} will paste its \code{value} as plain text.}
+# \item{\code{name="!--"}}{Creates a comment tag, i.e., this will comment out all its \code{children}.}
+# \item{\code{name="![CDATA["}}{Creates a CDATA section and places all its \code{children} in it.}
+# }
+#
+# @title S4 class XiMpLe.node
+# @slot name Name of the node (i.e., the XML tag identifier). For special names see details.
+# @slot attributes A list of named character values, representing the attributes of this node.
+# @slot children A list of further objects of class XiMpLe.node, representing child nodes of this node.
+# @slot value Plain text to be used as the enclosed value of this node. Set to \code{value=""} if you
+# want a childless node to be forced into an non-empty pair of start and end tags by \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}}.
+# @name XiMpLe.node,-class
+# @aliases XiMpLe.node-class XiMpLe.node,-class
+#' @import methods
+# @keywords classes
+#' @noRd
+# @rdname XiMpLe.node-class
+# @exportClass XiMpLe.node
+#' @export
+
+setClass("XiMpLe.node",
+ representation=representation(
+ name="character",
+ attributes="list",
+ children="list",
+ value="character"
+ ),
+ prototype(
+ name=character(),
+ attributes=list(),
+ children=list(),
+ value=character()
+ )
+)
+
+setValidity("XiMpLe.node", function(object){
+ obj.name <- object at name
+ obj.attributes <- object at attributes
+ obj.children <- object at children
+ obj.value <- object at value
+
+ if(isTRUE(!nchar(obj.name) > 0) & isTRUE(!nchar(obj.value) > 0)){
+ print(str(object))
+ stop(simpleError("Invalid object: A node must at least have a name or a value!"))
+ } else {}
+
+ obj.attributes.names <- names(obj.attributes)
+ # if there are attributes, check that they all have names
+ if(length(obj.attributes) > 0){
+ if(length(obj.attributes) != length(obj.attributes.names)){
+ stop(simpleError("Invalid object: All attributes must have names!"))
+ } else {}
+ } else {}
+
+ # check content of children
+ if(length(obj.children) > 0){
+ child.nodes <- sapply(obj.children, function(this.child){inherits(this.child, "XiMpLe.node")})
+ if(!all(child.nodes)){
+ stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
+ } else {}
+ } else {}
+ return(TRUE)
+})
Added: trunk/rkward/packages/XiMpLe/R/node.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/node.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/node.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,156 @@
+#' Extract/manipulate a node or parts of it from an XML tree
+#'
+#' This method can be used to get parts of a parsed XML tree object, or to fill it with new values.
+#'
+#' @param obj An object of class \code{XiMpLe.doc}
+#' @param node A list of node names (or their numeric values), where each element is
+#' the child of its previous element. duplicate matches will be returned as a list.
+#' @param what A character string, must be a valid slot name of class \code{XiMpLe.node}, like
+#' \code{"attributes"} or \code{"value"}. If not \code{NULL}, only that part of a node will be returned.
+#' There's also two special properties for this option: \code{what="@@path"} will not return the
+#' node or it's contents, but a character string with the "path" to it in the object; \code{what="obj@@path"}
+#' is the same but won't have \code{obj} substituted with the object's name.
+#' @param cond.attr A named character string, to further filter the returned results.
+#' If not \code{NULL}, only nodes with fully matching attributes will be considered.
+#' @param cond.value A character string, similar to \code{cond.attr}, but is matched
+#' against the value between a pair of tags.
+#' @param element A character string naming one list element of the node slot. If \code{NULL}, all
+#' elements will be returned.
+#' @include XiMpLe.doc-class.R
+#' @include XiMpLe.node-class.R
+#' @import methods
+#' @aliases node,XiMpLe.doc-method node<- node<-,XiMpLe.doc-method
+#' @examples
+#' \dontrun{
+#' node(my.xml.tree, node=list("html","body"), what="attributes")
+#' node(my.xml.tree, node=list("html","head","title"), what="value") <- "foobar"
+#' }
+#' @export
+setGeneric("node", function(obj, node=list(), what=NULL, cond.attr=NULL, cond.value=NULL, element=NULL){standardGeneric("node")})
+
+setMethod("node",
+ signature(obj="XiMpLe.doc"),
+ function(obj, node=list(), what=NULL, cond.attr=NULL, cond.value=NULL, element=NULL){
+
+ result.node.path <- "obj"
+ for (this.node in node){
+ for (this.path in result.node.path){
+ this.node.part <- eval(parse(text=this.path))
+ got.this <- names(this.node.part at children) %in% this.node
+ if(!any(got.this)){
+ # apparently, this node doesn't exist
+ stop(simpleError(paste("Can't find node ", sQuote(this.node), " in ", sQuote(deparse(substitute(obj))), "!", sep="")))
+ } else {
+ result.node.path <- unique(paste(result.node.path, paste("@children[[",which(got.this),"]]", sep=""), sep=""))
+ }
+ }
+ }
+
+ # filter by attributes
+ if(!is.null(cond.attr)){
+ filter <- names(cond.attr)
+ filtered.paths <- c()
+ for (this.path in result.node.path){
+ this.node.part <- eval(parse(text=this.path))
+ this.attrs <- slot(this.node.part, "attributes")
+ attr.found <- filter %in% names(this.attrs)
+ # were the wanted attributes found at all?
+ if(all(attr.found)){
+ # check if they're all equal
+ found.this <- sapply(filter, function(this.attr){
+ results <- unlist(cond.attr[this.attr]) == unlist(this.attrs[this.attr])
+ return(results)
+ })
+ if(all(found.this)){
+ filtered.paths <- unique(c(filtered.paths, this.path))
+ } else {}
+ } else {}
+ }
+ result.node.path <- filtered.paths
+ } else {}
+ # create a list with matching node objects
+ result.cond <- sapply(result.node.path, function(this.path){eval(parse(text=this.path))})
+ names(result.cond) <- NULL
+
+ if(!is.null(cond.value)){
+ stopifnot(length(cond.value) == 1)
+ filtered.paths <- c()
+ for (this.path in result.node.path){
+ this.node.part <- eval(parse(text=this.path))
+ this.value <- slot(this.node.part, "value")
+ if(identical(this.value, cond.value)){
+ filtered.paths <- unique(c(filtered.paths, this.path))
+ } else {}
+ }
+ result.node.path <- filtered.paths
+ } else {}
+
+ if(!is.null(what)){
+ stopifnot(length(what) == 1)
+ if(!what %in% c(slotNames(new("XiMpLe.node")), "@path", "obj at path")){
+ stop(simpleError(paste("Invalid slot for class XiMpLe.node:", paste(sQuote(what), collapse=", "), "!", sep="")))
+ } else {}
+ if(identical(what, "@path")){
+ ## return subtituted path info
+ result.node.path <- gsub("^obj", paste(deparse(substitute(obj))), result.node.path)
+ return(result.node.path)
+ } else if(identical(what, "obj at path")){
+ ## return path info
+ return(result.node.path)
+ } else {}
+ result <- unlist(lapply(result.node.path, function(this.path){
+ this.node <- eval(parse(text=this.path))
+ results <- slot(this.node, what)
+ if(!is.null(element)){
+ results <- results[element]
+ } else {}
+ return(results)
+ }))
+ # turn from vector to list for attributes, so they can be reached with "$"
+ if(identical(what, "attributes")){
+ result <- as.list(result)
+ } else {}
+ } else {
+ result <- unlist(lapply(result.node.path, function(this.path){
+ return(eval(parse(text=this.path)))
+ }))
+ }
+
+ # no need for a list if it's inly one node
+ if(length(result) == 1){
+ if(inherits(result[[1]], "XiMpLe.node") | !is.null(element)){
+ result <- result[[1]]
+ } else {}
+ } else {}
+
+ return(result)
+ }
+)
+
+#' @export
+setGeneric("node<-", function(obj, node=list(), what=NULL, cond.attr=NULL, cond.value=NULL, element=NULL, value){standardGeneric("node<-")})
+
+setMethod("node<-",
+ signature(obj="XiMpLe.doc"),
+ function(obj, node=list(), what=NULL, cond.attr=NULL, cond.value=NULL, element=NULL, value){
+
+ # get path to node in object
+ obj.paths <- node(obj, node=node, what="obj at path", cond.attr=cond.attr, cond.value=cond.value)
+ if(is.null(obj.paths)){
+ # seems we need to create this node
+ stop(simpleError("Node not found."))
+ } else {}
+ for (this.node in obj.paths){
+ if(!is.null(what)){
+ this.node <- paste(this.node, "@", what, sep="")
+ if(!is.null(element)){
+ this.node <- paste(this.node, "[[\"",element,"\"]]", sep="")
+ } else {}
+ } else {}
+
+ eval(parse(text=paste(this.node, " <- ", deparse(value), sep="")))
+ }
+
+ return(obj)
+ }
+)
Added: trunk/rkward/packages/XiMpLe/R/parseXMLTree.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/parseXMLTree.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/parseXMLTree.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,47 @@
+#' Read an XML file into an R object
+#'
+#' @param file Character string, valid path to the XML file which should be parsed.
+#' @param drop Character vector with the possible values \code{"comments"}, \code{"cdata"}
+#' \code{"declarations"} and \code{"doctype"}, defining element classes to be dropped
+#' from the resulting object.
+#' @return An object of class \code{XiMpLe.doc} with four slots:
+#' \describe{
+#' \item{\code{file}:}{Full path to the parsed file.}
+#' \item{\code{xml}:}{XML declaration, if found.}
+#' \item{\code{dtd}:}{Doctype definition, if found.}
+#' \item{\code{children}:}{A list of objects of class \code{XiMpLe.node}, with the elements
+#' \code{"name"} (the node name), \code{"attributes"} (list of attributes, if found),
+#' \code{"children"} (list of \code{XiMpLe.node} object, if found) and \code{"value"}
+#' (text value between a pair of start/end tags, if found).}
+#' }
+#' @export
+
+parseXMLTree <- function(file, drop=NULL){
+ xml.raw <- paste(readLines(file), collapse=" ")
+
+ single.tags <- XML.single.tags(xml.raw, drop=drop)
+
+ # check for XML declaration and doctype first
+ if(XML.declaration(single.tags[1])){
+ XML.decl <- parseXMLAttr(single.tags[1])
+ single.tags <- single.tags[-1]
+ } else {
+ XML.decl <- list(version="", encoding="", standalone="")
+ }
+ if(any(XML.doctype(single.tags[1]))){
+ XML.doct <- parseXMLAttr(single.tags[1])
+ single.tags <- single.tags[-1]
+ } else {
+ XML.doct <- list(doctype="", id="", decl="", refer="")
+ }
+ # try to iterate through the single tags
+ children <- XML.nodes(single.tags)[["children"]]
+
+ results <- new("XiMpLe.doc",
+ file=normalizePath(file),
+ xml=XML.decl,
+ dtd=XML.doct,
+ children=children)
+
+ return(results)
+}
Added: trunk/rkward/packages/XiMpLe/R/pasteXMLNode.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/pasteXMLNode.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/pasteXMLNode.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,58 @@
+#' Paste an XML node from a XiMpLe.node object
+#'
+#' @param node An object of class \code{XiMpLe.node}.
+#' @param level Indentation level.
+#' @param shine Integer, controlling if the output should be formatted for better readability. Possible values:
+#' \describe{
+#' \item{0}{No formatting.}
+#' \item{1}{Nodes will be indented.}
+#' \item{2}{Nodes will be indented and each attribute gets a new line.}
+#' }
+#' @param indent.by A charachter string defining how indentation should be done. Defaults to tab.
+#' @include XiMpLe.node-class.R
+#' @export
+pasteXMLNode <- function(node, level=1, shine=1, indent.by="\t"){
+ if(!inherits(node, "XiMpLe.node")){
+ if(inherits(node, "XiMpLe.doc")){
+ # hand over to pasteXMLTree()
+ warning("'node' is of class XiMpLe.doc, called pasteXMLTree() instead.")
+ return(pasteXMLTree(obj=node, shine=shine, indent.by=indent.by))
+ } else {
+ stop(simpleError("'node' must be of class XiMpLe.node!"))
+ }
+ } else {}
+
+ new.indent <- ifelse(shine > 0, indent(level+1, by=indent.by), "")
+ new.node <- ifelse(shine > 0, "\n", "")
+
+ # get the slot contents
+ node.name <- slot(node, "name")
+ node.attr <- slot(node, "attributes")
+ node.chld <- slot(node, "children")
+ node.val <- slot(node, "value")
+
+ if(!length(node.attr) > 0){
+ node.attr <- NULL
+ } else {}
+
+ if(length(node.chld) > 0){
+ node.chld <- paste(unlist(sapply(node.chld, function(this.node){
+ return(pasteXMLNode(this.node, level=(level + 1), shine=shine, indent.by=indent.by))})), collapse="", sep="")
+ node.empty <- FALSE
+ } else {
+ node.chld <- NULL
+ node.empty <- TRUE
+ }
+
+ # take care of text value
+ if(length(node.val) > 0){
+ node.empty <- FALSE
+ if(nchar(node.val) > 0){
+ node.chld <- paste(new.indent, paste(node.val, collapse=" "), new.node, sep="")
+ } else {}
+ } else {}
+
+ pasted.node <- pasteXMLTag(node.name, attr=node.attr, child=node.chld, empty=node.empty, level=level, allow.empty=TRUE, rename=NULL, shine=shine, indent.by=indent.by)
+
+ return(pasted.node)
+}
Added: trunk/rkward/packages/XiMpLe/R/pasteXMLTag.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/pasteXMLTag.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/pasteXMLTag.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,63 @@
+#' Write an XML tag
+#'
+#' Creates a whole XML tag with attributes and, if it is a pair of start and end tags,
+#' also one object as child. This can be used recursively to create whole XML tree structures
+#' with this one function.
+#'
+#' @param tag Character string, name of the XML tag.
+#' @param attr A list of attributes for the tag.
+#' @param child If \code{empty=FALSE}, a character string to be pasted as a child node between start and end tag.
+#' @param empty Logical, <true /> or <false></false>
+#' @param level Indentation level.
+#' @param allow.empty Logical, if \code{FALSE}, tags without attributes will not be returned.
+#' @param rename An optional named list if the attributes in XML need to be renamed from their list names in \code{attr}.
+#' This list must in turn have a list element named after \code{tag}, containing named character elements, where the
+#' names represent the element names in \code{attr} and their values the names the XML attribute should get.
+#' @param shine Integer, controlling if the output should be formatted for better readability. Possible values:
+#' \describe{
+#' \item{0}{No formatting.}
+#' \item{1}{Nodes will be indented.}
+#' \item{2}{Nodes will be indented and each attribute gets a new line.}
+#' }
+#' @param indent.by A charachter string defining how indentation should be done. Defaults to tab.
+#' @export
+pasteXMLTag <- function(tag, attr=NULL, child=NULL, empty=TRUE, level=1, allow.empty=FALSE, rename=NULL, shine=2, indent.by="\t"){
+ # what attributes do we have?
+ all.attributes <- pasteXMLAttr(attr, tag=tag, level=level, rename=rename, shine=shine, indent.by=indent.by)
+ # probaly don't produce empty tags
+ if(!isTRUE(allow.empty) & is.null(all.attributes)){
+ return("")
+ } else {}
+
+ new.node <- ifelse(shine > 0, "\n", "")
+ new.indent <- ifelse(shine > 0, indent(level, by=indent.by), "")
+ new.attr <- ifelse(shine > 1, "\n", "")
+ new.attr.indent <- ifelse(shine > 1, indent(level, by=indent.by), "")
+ attr.space <- ifelse(nchar(all.attributes) > 0, " ", "")
+ new.cmmt.indent <- ifelse(shine > 1, indent(level + 1, by=indent.by), "")
+
+ # three special cases: value pseudotags, comments and CDATA
+ if(isTRUE(nchar(tag) == 0) | length(tag) == 0){
+ full.tag <- paste(new.indent, child, new.node, sep="")
+ } else if(identical(tag, "!--")){
+ full.tag <- paste(new.indent, "<!-- ", new.attr, new.cmmt.indent, if(!is.null(child)){trim(child)}, " ", new.attr, new.attr.indent, "-->", new.node, sep="")
+ } else if(identical(tag, "![CDATA[")){
+ full.tag <- paste(new.indent, "<![CDATA[ ", new.attr, new.cmmt.indent, if(!is.null(child)){trim(child)}, " ", new.attr, new.attr.indent, "]]>", new.node, sep="")
+ } else {
+ # only put attributes in new lines if there's more than one
+ new.attr <- ifelse((length(attr) > 1), new.attr, "")
+ new.attr.indent <- ifelse((length(attr) > 1), new.attr.indent, "")
+ new.cmmt.indent <- ifelse((length(attr) > 1), new.cmmt.indent, "")
+ # empty decides whether this is a empty tag or a pair of start and end tags
+ if(isTRUE(empty)){
+ full.tag <- paste(new.indent, "<", tag, attr.space, new.attr, new.cmmt.indent, all.attributes, new.attr, new.attr.indent, " />", new.node, sep="")
+ } else {
+ full.tag <- paste(
+ new.indent, "<", tag, attr.space, new.attr, new.cmmt.indent, all.attributes, new.attr, new.attr.indent, ">", new.node,
+ if(!is.null(child)){child},
+ new.indent, "</", tag, ">", new.node, sep="")
+ }
+ }
+
+ return(full.tag)
+}
Added: trunk/rkward/packages/XiMpLe/R/pasteXMLTree.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/pasteXMLTree.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/pasteXMLTree.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,59 @@
+#' Paste an XML tree structure from a XiMpLe.doc object
+#'
+#' @param obj An object of class \code{XiMpLe.doc}.
+#' @param shine Integer, controlling if the output should be formatted for better readability. Possible values:
+#' \describe{
+#' \item{0}{No formatting.}
+#' \item{1}{Nodes will be indented.}
+#' \item{2}{Nodes will be indented and each attribute gets a new line.}
+#' }
+#' @param indent.by A charachter string defining how indentation should be done. Defaults to tab.
+#' @include XiMpLe.doc-class.R
+#' @export
+pasteXMLTree <- function(obj, shine=1, indent.by="\t"){
+ if(!inherits(obj, "XiMpLe.doc")){
+ if(inherits(obj, "XiMpLe.node")){
+ # hand over to pasteXMLNode()
+ warning("'node' is of class XiMpLe.node, called pasteXMLNode() instead.")
+ return(pasteXMLNode(node=obj, shine=shine, indent.by=indent.by))
+ } else {
+ stop(simpleError("'obj' must be of class XiMpLe.doc!"))
+ }
+ } else {}
+
+ filename <- slot(obj, "file")
+ tree.xml <- slot(obj, "xml")
+ tree.doctype <- slot(obj, "dtd")
+ tree.nodes <- slot(obj, "children")
+
+ if(any(nchar(unlist(tree.xml)) > 0)) {
+ doc.xml <- pasteXMLTag("?xml", attr=tree.xml, child=NULL, empty=TRUE, level=1, allow.empty=FALSE, rename=NULL, shine=min(1, shine), indent.by=indent.by)
+ doc.xml <- gsub("/>", "\\?>", doc.xml)
+ } else {
+ doc.xml <- ""
+ }
+
+ if(any(nchar(unlist(tree.doctype)) > 0)) {
+ new.node <- ifelse(shine > 0, "\n", "")
+ doc.doctype <- paste("<!DOCTYPE ", paste(tree.doctype[["doctype"]], tree.doctype[["id"]], sep=" "), sep="")
+ if(length(tree.doctype[["refer"]]) > 0) {
+ if(nchar(tree.doctype[["refer"]]) > 0){
+ doc.doctype <- paste(doc.doctype, " \"",tree.doctype[["refer"]], "\"", sep="")
+ } else {}
+ } else {}
+ doc.doctype <- paste(doc.doctype, ">", new.node, sep="")
+ } else {
+ doc.doctype <- ""
+ }
+
+ if(length(tree.nodes) > 0) {
+ doc.nodes <- paste(unlist(sapply(tree.nodes, function(this.node){
+ return(pasteXMLNode(this.node, level=1, shine=shine, indent.by=indent.by))})), collapse="", sep="")
+ } else {
+ doc.nodes <- ""
+ }
+
+ doc.all <- paste(doc.xml, doc.doctype, doc.nodes, collapse="", sep="")
+
+ return(doc.all)
+}
Added: trunk/rkward/packages/XiMpLe/R/show.XiMpLe.doc.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/show.XiMpLe.doc.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/show.XiMpLe.doc.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,15 @@
+#' Show method for S4 objects of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+#'
+#' @title Show method for objects of class XiMpLe.doc
+#' @param object An object of class \code{XiMpLe.doc}
+#' @aliases show,-methods show,XiMpLe.doc-method
+#' @seealso \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+#' @keywords methods
+#' @exportMethod show
+#' @rdname show-methods
+setGeneric("show")
+
+#' @rdname show-methods
+setMethod("show", signature(object="XiMpLe.doc"), function(object){
+ cat(pasteXMLTree(object))
+})
Added: trunk/rkward/packages/XiMpLe/R/show.XiMpLe.node.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/show.XiMpLe.node.R (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/show.XiMpLe.node.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,15 @@
+#' Show method for S4 objects of class \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
+#'
+#' @title Show method for objects of class XiMpLe.node
+#' @param object An object of class \code{XiMpLe.node}
+#' @aliases show,-methods show,XiMpLe.node-method
+#' @seealso \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
+#' @keywords methods
+#' @exportMethod show
+#' @rdname show-methods
+setGeneric("show")
+
+#' @rdname show-methods
+setMethod("show", signature(object="XiMpLe.node"), function(object){
+ cat(pasteXMLNode(object))
+})
Added: trunk/rkward/packages/XiMpLe/inst/CITATION
===================================================================
--- trunk/rkward/packages/XiMpLe/inst/CITATION (rev 0)
+++ trunk/rkward/packages/XiMpLe/inst/CITATION 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,14 @@
+bibentry("Manual",
+ title="XiMpLe: A simple XML tree parser and generator",
+ author="Meik Michalke",
+ year="2011",
+ note="(Version 0.03-4)",
+ url="http://rkward.sourceforge.net",
+
+ textVersion =
+ paste("Michalke, M. (2011). ",
+ "XiMpLe: A simple XML tree parser and generator (Version 0.03-4). ",
+ "Available from http://rkward.sourceforge.net",
+ sep=""),
+
+ mheader = "To cite XiMpLe in publications use:")
Added: trunk/rkward/packages/XiMpLe/man/XiMpLe-package.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/XiMpLe-package.Rd (rev 0)
+++ trunk/rkward/packages/XiMpLe/man/XiMpLe-package.Rd 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,29 @@
+\docType{package}
+\name{XiMpLe-package}
+\alias{XiMpLe}
+\alias{XiMpLe-package}
+\title{A simple XML tree parser and generator.}
+\description{
+ A simple XML tree parser and generator.
+}
+\details{
+ \tabular{ll}{ Package: \tab XiMpLe\cr Type: \tab
+ Package\cr Version: \tab 0.03-4\cr Date: \tab
+ 2011-10-01\cr Depends: \tab R (>= 2.9.0),methods\cr
+ Enhances: \tab rkward\cr Encoding: \tab UTF-8\cr License:
+ \tab GPL (>= 3)\cr LazyLoad: \tab yes\cr URL: \tab
+ http://rkward.sourceforge.net\cr }
+
+ This package provides a simple XML tree parser/generator.
+ It includes functions to read XML files into R objects,
+ get information out of and into nodes, and write R
+ objects back to XML code. It's not as powerful as the XML
+ package and doesn't aim to be, but for simple XML
+ handling it could be useful. It was originally programmed
+ for RKWard.
+}
+\author{
+ m.eik michalke \email{meik.michalke at hhu.de}
+}
+\keyword{package}
+
Added: trunk/rkward/packages/XiMpLe/man/XiMpLe.doc-class.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/XiMpLe.doc-class.Rd (rev 0)
+++ trunk/rkward/packages/XiMpLe/man/XiMpLe.doc-class.Rd 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,9 @@
+\name{XiMpLe.doc-class}
+\title{S4 class XiMpLe.doc}
+\description{Class XiMpLe.doc}
+\details{This class is used for objects that are returned by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.}
+\alias{XiMpLe.doc-class}
+\alias{XiMpLe.doc,-class}
+\keyword{classes}
+\section{Slots}{\describe{\item{\code{file}:}{(\code{\link{character}}) Name of the file.}\item{\code{xml}:}{(\code{\link{list}}) XML declaration of the file.}\item{\code{dtd}:}{(\code{\link{list}}) Doctype definition of the file.}\item{\code{children}:}{(\code{\link{list}}) A list of objects of class XiMpLe.node, representing the DOM structure of the XML document.}}}
+
Added: trunk/rkward/packages/XiMpLe/man/XiMpLe.node-class.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/XiMpLe.node-class.Rd (rev 0)
+++ trunk/rkward/packages/XiMpLe/man/XiMpLe.node-class.Rd 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,19 @@
+\name{XiMpLe.node-class}
+\title{S4 class XiMpLe.node}
+\description{Class XiMpLe.node}
+\details{This class is used to create DOM trees of XML documents, like objects that are returned
+by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
+
+There are certain special values predefined for the \code{name} slot to easily create special XML elements:
+\describe{
+\item{\code{name=""}}{If the name is an empty character string, a pseudo node is created,
+\code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}} will paste its \code{value} as plain text.}
+\item{\code{name="!--"}}{Creates a comment tag, i.e., this will comment out all its \code{children}.}
+\item{\code{name="![CDATA["}}{Creates a CDATA section and places all its \code{children} in it.}
+}}
+\alias{XiMpLe.node-class}
+\alias{XiMpLe.node,-class}
+\keyword{classes}
+\section{Slots}{\describe{\item{\code{name}:}{(\code{\link{character}}) Name of the node (i.e., the XML tag identifier). For special names see details.}\item{\code{attributes}:}{(\code{\link{list}}) A list of named character values, representing the attributes of this node.}\item{\code{children}:}{(\code{\link{list}}) A list of further objects of class XiMpLe.node, representing child nodes of this node.}\item{\code{value}:}{(\code{\link{character}}) Plain text to be used as the enclosed value of this node. Set to \code{value=""} if you
+want a childless node to be forced into an non-empty pair of start and end tags by \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}}.}}}
+
Added: trunk/rkward/packages/XiMpLe/man/node.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/node.Rd (rev 0)
+++ trunk/rkward/packages/XiMpLe/man/node.Rd 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,46 @@
+\name{node}
+\alias{node}
+\alias{node<-}
+\alias{node<-,XiMpLe.doc-method}
+\alias{node,XiMpLe.doc-method}
+\title{Extract/manipulate a node or parts of it from an XML tree}
+\arguments{
+ \item{obj}{An object of class \code{XiMpLe.doc}}
+
+ \item{node}{A list of node names (or their numeric
+ values), where each element is the child of its previous
+ element. duplicate matches will be returned as a list.}
+
+ \item{what}{A character string, must be a valid slot name
+ of class \code{XiMpLe.node}, like \code{"attributes"} or
+ \code{"value"}. If not \code{NULL}, only that part of a
+ node will be returned. There's also two special
+ properties for this option: \code{what="@path"} will not
+ return the node or it's contents, but a character string
+ with the "path" to it in the object;
+ \code{what="obj at path"} is the same but won't have
+ \code{obj} substituted with the object's name.}
+
+ \item{cond.attr}{A named character string, to further
+ filter the returned results. If not \code{NULL}, only
+ nodes with fully matching attributes will be considered.}
+
+ \item{cond.value}{A character string, similar to
+ \code{cond.attr}, but is matched against the value
+ between a pair of tags.}
+
+ \item{element}{A character string naming one list element
+ of the node slot. If \code{NULL}, all elements will be
+ returned.}
+}
+\description{
+ This method can be used to get parts of a parsed XML tree
+ object, or to fill it with new values.
+}
+\examples{
+\dontrun{
+node(my.xml.tree, node=list("html","body"), what="attributes")
+node(my.xml.tree, node=list("html","head","title"), what="value") <- "foobar"
+}
+}
+
Added: trunk/rkward/packages/XiMpLe/man/parseXMLTree.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/parseXMLTree.Rd (rev 0)
+++ trunk/rkward/packages/XiMpLe/man/parseXMLTree.Rd 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,31 @@
+\name{parseXMLTree}
+\alias{parseXMLTree}
+\title{Read an XML file into an R object}
+\usage{
+ parseXMLTree(file, drop = NULL)
+}
+\arguments{
+ \item{file}{Character string, valid path to the XML file
+ which should be parsed.}
+
+ \item{drop}{Character vector with the possible values
+ \code{"comments"}, \code{"cdata"} \code{"declarations"}
+ and \code{"doctype"}, defining element classes to be
+ dropped from the resulting object.}
+}
+\value{
+ An object of class \code{XiMpLe.doc} with four slots:
+ \describe{ \item{\code{file}:}{Full path to the parsed
+ file.} \item{\code{xml}:}{XML declaration, if found.}
+ \item{\code{dtd}:}{Doctype definition, if found.}
+ \item{\code{children}:}{A list of objects of class
+ \code{XiMpLe.node}, with the elements \code{"name"} (the
+ node name), \code{"attributes"} (list of attributes, if
+ found), \code{"children"} (list of \code{XiMpLe.node}
+ object, if found) and \code{"value"} (text value between
+ a pair of start/end tags, if found).} }
+}
+\description{
+ Read an XML file into an R object
+}
+
Added: trunk/rkward/packages/XiMpLe/man/pasteXMLNode.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/pasteXMLNode.Rd (rev 0)
+++ trunk/rkward/packages/XiMpLe/man/pasteXMLNode.Rd 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,25 @@
+\name{pasteXMLNode}
+\alias{pasteXMLNode}
+\title{Paste an XML node from a XiMpLe.node object}
+\usage{
+ pasteXMLNode(node, level = 1, shine = 1, indent.by =
+ "\t")
+}
+\arguments{
+ \item{node}{An object of class \code{XiMpLe.node}.}
+
+ \item{level}{Indentation level.}
+
+ \item{shine}{Integer, controlling if the output should be
+ formatted for better readability. Possible values:
+ \describe{ \item{0}{No formatting.} \item{1}{Nodes will
+ be indented.} \item{2}{Nodes will be indented and each
+ attribute gets a new line.} }}
+
+ \item{indent.by}{A charachter string defining how
+ indentation should be done. Defaults to tab.}
+}
+\description{
+ Paste an XML node from a XiMpLe.node object
+}
+
Added: trunk/rkward/packages/XiMpLe/man/pasteXMLTag.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/pasteXMLTag.Rd (rev 0)
+++ trunk/rkward/packages/XiMpLe/man/pasteXMLTag.Rd 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,47 @@
+\name{pasteXMLTag}
+\alias{pasteXMLTag}
+\title{Write an XML tag}
+\usage{
+ pasteXMLTag(tag, attr = NULL, child = NULL, empty = TRUE,
+ level = 1, allow.empty = FALSE, rename = NULL, shine = 2,
+ indent.by = "\t")
+}
+\arguments{
+ \item{tag}{Character string, name of the XML tag.}
+
+ \item{attr}{A list of attributes for the tag.}
+
+ \item{child}{If \code{empty=FALSE}, a character string to
+ be pasted as a child node between start and end tag.}
+
+ \item{empty}{Logical, <true /> or <false></false>}
+
+ \item{level}{Indentation level.}
+
+ \item{allow.empty}{Logical, if \code{FALSE}, tags without
+ attributes will not be returned.}
+
+ \item{rename}{An optional named list if the attributes in
+ XML need to be renamed from their list names in
+ \code{attr}. This list must in turn have a list element
+ named after \code{tag}, containing named character
+ elements, where the names represent the element names in
+ \code{attr} and their values the names the XML attribute
+ should get.}
+
+ \item{shine}{Integer, controlling if the output should be
+ formatted for better readability. Possible values:
+ \describe{ \item{0}{No formatting.} \item{1}{Nodes will
+ be indented.} \item{2}{Nodes will be indented and each
+ attribute gets a new line.} }}
+
+ \item{indent.by}{A charachter string defining how
+ indentation should be done. Defaults to tab.}
+}
+\description{
+ Creates a whole XML tag with attributes and, if it is a
+ pair of start and end tags, also one object as child.
+ This can be used recursively to create whole XML tree
+ structures with this one function.
+}
+
Added: trunk/rkward/packages/XiMpLe/man/pasteXMLTree.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/pasteXMLTree.Rd (rev 0)
+++ trunk/rkward/packages/XiMpLe/man/pasteXMLTree.Rd 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,22 @@
+\name{pasteXMLTree}
+\alias{pasteXMLTree}
+\title{Paste an XML tree structure from a XiMpLe.doc object}
+\usage{
+ pasteXMLTree(obj, shine = 1, indent.by = "\t")
+}
+\arguments{
+ \item{obj}{An object of class \code{XiMpLe.doc}.}
+
+ \item{shine}{Integer, controlling if the output should be
+ formatted for better readability. Possible values:
+ \describe{ \item{0}{No formatting.} \item{1}{Nodes will
+ be indented.} \item{2}{Nodes will be indented and each
+ attribute gets a new line.} }}
+
+ \item{indent.by}{A charachter string defining how
+ indentation should be done. Defaults to tab.}
+}
+\description{
+ Paste an XML tree structure from a XiMpLe.doc object
+}
+
Added: trunk/rkward/packages/XiMpLe/man/show-methods.Rd
===================================================================
--- trunk/rkward/packages/XiMpLe/man/show-methods.Rd (rev 0)
+++ trunk/rkward/packages/XiMpLe/man/show-methods.Rd 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,25 @@
+\name{show}
+\alias{show}
+\alias{show,-methods}
+\alias{show,XiMpLe.doc-method}
+\alias{show,XiMpLe.node-method}
+\title{Show method for objects of class XiMpLe.doc}
+\arguments{
+ \item{object}{An object of class \code{XiMpLe.doc}}
+
+ \item{object}{An object of class \code{XiMpLe.node}}
+}
+\description{
+ Show method for S4 objects of class
+ \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+
+ Show method for S4 objects of class
+ \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
+}
+\seealso{
+ \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+
+ \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
+}
+\keyword{methods}
+
Added: trunk/rkward/packages/rkwarddev/ChangeLog
===================================================================
--- trunk/rkward/packages/rkwarddev/ChangeLog (rev 0)
+++ trunk/rkward/packages/rkwarddev/ChangeLog 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,73 @@
+ChangeLog for package rkwarddev
+
+## 0.02-3 (2011-09-30)
+ - added functions rk.XML.attribute(), rk.XML.component(), rk.XML.components(), rk.XML.context(),
+ rk.XML.entry(), rk.XML.hierarchy(), rk.XML.menu() and rk.XML.require()
+ - rk.plugin.skeleton() and rk.XML.pluginmap() now use the new functions, which makes them much more flexible
+ - added option "menu" to rk.plugin.skeleton()
+ - added options "require", "x11.context", "import.context" and "hints" to rk.XML.pluginmap()
+ - removed now superfluous option "plugin.dir" from rk.XML.pluginmap()
+ - tuned rk.plugin.skeleton() to only skip file writing if they exist
+
+## 0.02-2 (2011-09-29)
+ - added "load" and "show" options to rk.plugin.skeleton() to call rk.load.pluginmaps() and the plugin itself
+ - added function rk.build.plugin()
+
+## 0.02-1 (2011-09-28)
+ - added functions rk.XML.insert(), rk.XML.include(), rk.XML.embed(), rk.XML.preview(),
+ rk.XML.snippet(), and rk.XML.snippets()
+ - added support for snippets section to rk.XML.plugin() and rk.plugin.skeleton()
+ - included formula node into rk.XML.vars() wrapper
+ - rk.XML.varslot() now automatically sets "multi=TRUE" if "min", "max" or "any" are set
+
+## 0.02-0 (2011-09-27)
+ - redesigned options for rk.XML.plugin() and rk.plugin.skeleton() for more consistency.
+ unfortunately, this breaks backwards compatibility!
+ - added functions rk.XML.varselector(), rk.XML.copy(), rk.XML.dialog(), rk.XML.page() and
+ rk.XML.wizard()
+ - added type checks to rk.XML.spinbox()
+ - added "id.name" and "label" to various functions
+ - updated rk.XML.formula()
+
+## 0.01-5 (2011-09-25)
+ - added functions rk.XML.formula(), rk.XML.convert(), rk.XML.connect(), rk.XML.logic(),
+ rk.XML.set() and rk.XML.external()
+ - added possibility to add custom XML code to the logic section with rk.XML.plugin()
+ and rk.plugin.skeleton()
+ - fixed id setting in rk.XML.browser()
+ - simplified rk.plugin.skeleton() and rk.XML.pluginmap() by making "about" entirely optional
+
+## 0.01-4 (2011-09-22)
+ - fixed wrong doc link and one wrong object name in rk.plugin.skeleton()
+ - fixed attribute typo in rk.XML.vars()
+ - fixed issue with auto-generated IDs (now using "_" instead of ".")
+ - added wizard code options to rk.XML.plugin() and rk.plugin.skeleton()
+ - added "edit" and "create" options to rk.plugin.skeleton()
+ - added function rk.XML.varslot()
+ - added possibility to add custom XML nodes to the varslot in rk.XML.vars()
+ - added possibility to paste ready-to-use JavaScript code directly to the preprocess(),
+ calculate() and printout() functions, respectively
+
+## 0.01-3 (2011-09-16)
+ - added rk.XML.spinbox() and missing options to rk.XML.browser() and rk.XML.saveobj()
+ - corrected browser default type in rk.XML.browser()
+ - added wizard option to rk.plugin.skeleton()
+
+## 0.01-2 (2011-09-15)
+ - reworked rk.XML.about() to use person class objects for authors, and need less info to
+ produce usable output
+
+## 0.01-1 (2011-09-05)
+ - added rk.JS.scan(), rk.JS.doc(), rk.JS.array(), rk.rkh.scan() and rk.rkh.doc()
+ - added rk.XML.browser(), rk.XML.input(), rk.XML.saveobj(), rk.XML.stretch() and rk.XML.text()
+ - added rk.testsuite.doc()
+ - shortened package name from "rkwardplugdev" to "rkwarddev"
+ - merged code into RKWard's svn tree
+
+## 0.01-0 (2011-08-30)
+ - forked rk.* functions from XiMpLe package into this one
+ - added functions rk.XML.cbox(), rk.XML.row(), rk.XML.col(), rk.XML.frame(),
+ rk.XML.radio() and rk.XML.vars()
+ - rewrote the ID handling
+ - added docs
+ - initial release via reaktanz.de
Added: trunk/rkward/packages/rkwarddev/DESCRIPTION
===================================================================
--- trunk/rkward/packages/rkwarddev/DESCRIPTION (rev 0)
+++ trunk/rkward/packages/rkwarddev/DESCRIPTION 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,73 @@
+Package: rkwarddev
+Type: Package
+Title: A collection of tools for RKWard plugin development
+Author: m.eik michalke <meik.michalke at hhu.de>
+Maintainer: m.eik michalke <meik.michalke at hhu.de>
+Depends:
+ R (>= 2.9.0),XiMpLe,rkward (>= 0.5.6)
+Enhances: rkward
+Description: Provides functions to create plugin skeletons
+ and XML structures for RKWard.
+License: GPL (>= 3)
+Encoding: UTF-8
+LazyLoad: yes
+URL: http://rkward.sourceforge.net
+Authors at R: c(person(given="Meik", family="Michalke",
+ email="meik.michalke at hhu.de", role=c("aut", "cre")))
+Version: 0.02-3
+Date: 2011-09-30
+Collate:
+ 'rk.build.plugin.R'
+ 'rk-internal.R'
+ 'rk.JS.array.R'
+ 'rk.JS.doc.R'
+ 'rk.JS.scan.R'
+ 'rk.plugin.skeleton.R'
+ 'rk.rkh.doc.R'
+ 'rk.rkh.scan.R'
+ 'rk.testsuite.doc.R'
+ 'rkwarddev-desc-internal.R'
+ 'rkwarddev-package.R'
+ 'rk.XML.about.R'
+ 'rk.XML.attribute.R'
+ 'rk.XML.browser.R'
+ 'rk.XML.cbox.R'
+ 'rk.XML.col.R'
+ 'rk.XML.component.R'
+ 'rk.XML.components.R'
+ 'rk.XML.connect.R'
+ 'rk.XML.context.R'
+ 'rk.XML.convert.R'
+ 'rk.XML.copy.R'
+ 'rk.XML.dialog.R'
+ 'rk.XML.dropdown.R'
+ 'rk.XML.embed.R'
+ 'rk.XML.entry.R'
+ 'rk.XML.external.R'
+ 'rk.XML.formula.R'
+ 'rk.XML.frame.R'
+ 'rk.XML.hierarchy.R'
+ 'rk.XML.include.R'
+ 'rk.XML.input.R'
+ 'rk.XML.insert.R'
+ 'rk.XML.logic.R'
+ 'rk.XML.menu.R'
+ 'rk.XML.page.R'
+ 'rk.XML.pluginmap.R'
+ 'rk.XML.plugin.R'
+ 'rk.XML.preview.R'
+ 'rk.XML.radio.R'
+ 'rk.XML.require.R'
+ 'rk.XML.row.R'
+ 'rk.XML.saveobj.R'
+ 'rk.XML.set.R'
+ 'rk.XML.snippet.R'
+ 'rk.XML.snippets.R'
+ 'rk.XML.spinbox.R'
+ 'rk.XML.stretch.R'
+ 'rk.XML.tabbook.R'
+ 'rk.XML.text.R'
+ 'rk.XML.varselector.R'
+ 'rk.XML.varslot.R'
+ 'rk.XML.vars.R'
+ 'rk.XML.wizard.R'
Added: trunk/rkward/packages/rkwarddev/NAMESPACE
===================================================================
--- trunk/rkward/packages/rkwarddev/NAMESPACE (rev 0)
+++ trunk/rkward/packages/rkwarddev/NAMESPACE 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,51 @@
+export(rk.build.plugin)
+export(rk.JS.array)
+export(rk.JS.doc)
+export(rk.JS.scan)
+export(rk.plugin.skeleton)
+export(rk.rkh.doc)
+export(rk.rkh.scan)
+export(rk.testsuite.doc)
+export(rk.XML.about)
+export(rk.XML.attribute)
+export(rk.XML.browser)
+export(rk.XML.cbox)
+export(rk.XML.col)
+export(rk.XML.component)
+export(rk.XML.components)
+export(rk.XML.connect)
+export(rk.XML.context)
+export(rk.XML.convert)
+export(rk.XML.copy)
+export(rk.XML.dialog)
+export(rk.XML.dropdown)
+export(rk.XML.embed)
+export(rk.XML.entry)
+export(rk.XML.external)
+export(rk.XML.formula)
+export(rk.XML.frame)
+export(rk.XML.hierarchy)
+export(rk.XML.include)
+export(rk.XML.input)
+export(rk.XML.insert)
+export(rk.XML.logic)
+export(rk.XML.menu)
+export(rk.XML.page)
+export(rk.XML.plugin)
+export(rk.XML.pluginmap)
+export(rk.XML.preview)
+export(rk.XML.radio)
+export(rk.XML.require)
+export(rk.XML.row)
+export(rk.XML.saveobj)
+export(rk.XML.set)
+export(rk.XML.snippet)
+export(rk.XML.snippets)
+export(rk.XML.spinbox)
+export(rk.XML.stretch)
+export(rk.XML.tabbook)
+export(rk.XML.text)
+export(rk.XML.vars)
+export(rk.XML.varselector)
+export(rk.XML.varslot)
+export(rk.XML.wizard)
Added: trunk/rkward/packages/rkwarddev/R/rk-internal.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk-internal.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk-internal.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,274 @@
+# internal functions for the rk.* functions
+
+auto.ids <- function(identifiers, prefix=NULL, suffix=NULL, chars=8){
+ identifiers <- gsub("[[:space:]]*[^[:alnum:]]*", "", identifiers)
+ id.names <- ifelse(nchar(identifiers) > 8, abbreviate(identifiers, minlength=chars), identifiers)
+ # check for uniqueness
+ if(any(duplicated(id.names))){
+ warning("IDs are not unique, please check!")
+ } else {}
+ ids <- paste(prefix, id.names, suffix, sep="")
+ return(ids)
+}
+
+# convenience function to let single children be provided without list()
+child.list <- function(children){
+ if(inherits(children, "XiMpLe.node")){
+ children <- list(children)
+ } else {}
+ return(children)
+}
+
+## function trim()
+# cuts off space at start and end of a character string
+trim <- function(char){
+ char <- gsub("^[[:space:]]*", "", char)
+ char <- gsub("[[:space:]]*$", "", char)
+ return(char)
+} ## end function trim()
+
+## function indent()
+# will create tabs to format the output
+indent <- function(level, by="\t"){
+ paste(rep(by, level-1), collapse="")
+} ## end function indent()
+
+## function get.single.tags()
+get.single.tags <- function(XML.obj, drop=NULL){
+ # determine if we need to read a file or process an XiMpLe object
+ if(inherits(XML.obj, "XiMpLe.doc")){
+ single.tags <- trim(unlist(strsplit(pasteXMLTree(XML.obj, shine=1, indent.by=""), split="\n")))
+ } else if(inherits(XML.obj, "XiMpLe.node")){
+ single.tags <- trim(unlist(strsplit(pasteXMLNode(XML.obj, shine=1, indent.by=""), split="\n")))
+ } else {
+ xml.raw <- paste(readLines(XML.obj), collapse=" ")
+ single.tags <- XiMpLe:::XML.single.tags(xml.raw, drop=drop)
+ }
+ names(single.tags) <- NULL
+
+ return(single.tags)
+} ## end function get.single.tags()
+
+
+## function get.IDs()
+# scans XML tags for defined IDs, returns a matrix with columns "id" and "abbrev"
+get.IDs <- function(single.tags, relevant.tags, add.abbrev){
+
+ single.tags <- single.tags[tolower(XiMpLe:::XML.tagName(single.tags)) %in% relevant.tags]
+ # we're only interested in entries with an ID
+ single.tags <- single.tags[grepl("[[:space:]]+id=", single.tags)]
+
+ ids <- t(sapply(single.tags, function(this.tag){
+ this.tag.name <- XiMpLe:::XML.tagName(this.tag)
+ this.tag.id <- XiMpLe:::parseXMLAttr(this.tag)[["id"]]
+ if(isTRUE(add.abbrev)){
+ this.tag.id.abbrev <- paste(ID.prefix(this.tag.name), this.tag.id, sep="")
+ } else {
+ this.tag.id.abbrev <- this.tag.id
+ }
+ return(c(id=this.tag.id, abbrev=this.tag.id.abbrev))
+ }
+ ))
+ rownames(ids) <- NULL
+
+ # do a check if all IDs are really unique
+ if("id" %in% names(ids)){
+ multiple.id <- duplicated(ids[,"id"])
+ if(any(multiple.id)){
+ warning(paste("IDs are not unique:\n ", paste(ids[multiple.id,"id"], collapse=", "), "\n Expect errors!", sep=""))
+ } else {}
+ }
+
+ return(ids)
+} ## end function get.IDs()
+
+## function camelCode()
+# changes the first letter of each string
+# (except for the first one) to upper case
+camelCode <- function(words){
+
+ words <- as.vector(unlist(sapply(words, function(cur.word){
+ unlist(strsplit(cur.word, split="[._]"))
+ })))
+
+ new.words <- sapply(words[-1], function(cur.word){
+ word.vector <- unlist(strsplit(cur.word, split=""))
+ word.vector[1] <- toupper(word.vector[1])
+ word.new <- paste(word.vector, collapse="")
+ return(word.new)
+ })
+
+ results <- paste(words[1], paste(new.words, collapse=""), sep="")
+
+ return(results)
+} ## end function camelCode()
+
+## function get.JS.vars()
+# <tag id="my.id" ...>
+# in XML will become
+# var my.id = getValue("my.id");
+get.JS.vars <- function(JS.var, XML.var=NULL, JS.prefix="", indent.by="", names.only=FALSE){
+ if(isTRUE(names.only)){
+ results <- camelCode(c(JS.prefix, JS.var))
+ } else {
+ results <- paste(indent.by, "var ", camelCode(c(JS.prefix, JS.var)), " = getValue(\"", XML.var, "\");\n", sep="")
+ }
+ return(results)
+} ## end function get.JS.vars()
+
+## function ID.prefix()
+ID.prefix <- function(initial, abbr=TRUE, length=3, dot=FALSE){
+ if(isTRUE(abbr)){
+ prfx <- abbreviate(initial, minlength=length, strict=TRUE)
+ } else {
+ # currently empty, but can later be used to define fixed abbreviations
+ prfx <- NULL
+ }
+ if(isTRUE(dot)){
+ prfx <- paste(prfx, ".", sep="")
+ } else {
+ prfx <- paste(prfx, "_", sep="")
+ }
+ return(prfx)
+} ## end function ID.prefix()
+
+## function node.soup()
+# pastes the nodes as XML, only alphanumeric characters, e.g. to generate auto-IDs
+node.soup <- function(nodes){
+ if(inherits(nodes, "XiMpLe.node")){
+ the.soup <- gsub("[^[:alnum:]]", "", pasteXMLNode(nodes, shine=0))
+ } else {
+ stop(simpleError("Nodes must be of class XiMpLe.node!"))
+ }
+ return(the.soup)
+}
+## end function node.soup()
+
+## function get.by.role()
+# filters a vector with person objects by roles
+get.by.role <- function(persons, role="aut"){
+ role.filter <- function(x){is.null(r <- x$role) | role %in% r}
+ filtered.persons <- Filter(role.filter, persons)
+ return(filtered.persons)
+} ## end function get.by.role()
+
+## function check.ID()
+check.ID <- function(node){
+ if(is.list(node)){
+ return(sapply(node, check.ID))
+ } else {}
+
+ if(inherits(node, "XiMpLe.node")){
+ node.ID <- node at attributes[["id"]]
+ } else if(is.character(node)){
+ node.ID <- node
+ } else {
+ stop(simpleError("Can't find an ID!"))
+ }
+
+ if(is.null(node.ID)){
+ warning("ID is NULL!")
+ } else {}
+
+ return(node.ID)
+}
+## end function check.ID()
+
+## function prop.validity()
+# checks if a property is valid for an XML node, if source is XiMpLe.node
+# if bool=FALSE, returns the property or ""
+prop.validity <- function(source, property, ignore.empty=TRUE, warn.only=TRUE, bool=TRUE){
+ if(identical(property, "") & isTRUE(ignore.empty)){
+ if(isTRUE(bool)){
+ return(TRUE)
+ } else {
+ return(property)
+ }
+ } else {}
+
+ if(inherits(source, "XiMpLe.node")){
+ tag.name <- source at name
+ } else {
+ if(isTRUE(bool)){
+ return(TRUE)
+ } else {
+ return(property)
+ }
+ }
+
+ all.valid.props <- list(
+ all=c("visible", "enabled", "required"),
+ text=c("text"),
+ varselector=c("selected", "root"),
+ varslot=c("available", "selected", "source"),
+ radio=c("string", "number"),
+ dropdown=c("string", "number"),
+ # option=c(),
+ checkbox=c("state"),
+ frame=c("checked"),
+ input=c("text"),
+ browser=c("selection"),
+ saveobject=c("selection", "parent", "objectname", "active"),
+ spinbox=c("int", "real"),
+ formula=c("model", "table", "labels", "fixed_factors", "dependent"),
+ embed=c("code"),
+ preview=c("state")
+ )
+
+ if(tag.name %in% names(all.valid.props)){
+ valid.props <- c(all.valid.props[["all"]], all.valid.props[[tag.name]])
+ } else {
+ valid.props <- c(all.valid.props[["all"]])
+ }
+
+ invalid.prop <- !property %in% valid.props
+ if(any(invalid.prop)){
+ if(isTRUE(warn.only)){
+ warning(paste("Some property you provided is invalid for '",tag.name,"' and was ignored: ",
+ paste(property[invalid.prop], collapse=", "), sep=""))
+ if(isTRUE(bool)){
+ return(FALSE)
+ } else {
+ return("")
+ }
+ } else {
+ stop(simpleError(paste("Some property you provided is invalid for '",tag.name,"' and was ignored: ",
+ paste(property[invalid.prop], collapse=", "), sep="")))
+ }
+ } else {
+ if(isTRUE(bool)){
+ return(TRUE)
+ } else {
+ return(property)
+ }
+ }
+}
+## end function prop.validity()
+
+## function check.type()
+check.type <- function(value, type, var.name, warn.only=TRUE){
+ if(inherits(value, type)){
+ return(invisible(NULL))
+ } else {
+ msg.text <- paste(sQuote(var.name), " should be of type ", type, "!", sep="")
+ if(isTRUE(warn.only)){
+ warning(msg.text)
+ } else {
+ stop(simpleError(msg.text))
+ }
+ }
+}
+## end function check.type()
+
+## function clean.name()
+clean.name <- function(name, message=TRUE){
+ name.orig <- name
+ name <- gsub("[[:space:]]*[^[:alnum:]_]*", "", name)
+ if(!identical(name.orig, name)){
+ if(isTRUE(message)){
+ message(paste("For filenames ", sQuote(name.orig), " was renamed to ", sQuote(name), ".", sep=""))
+ } else {}
+ } else {}
+ return(name)
+}
+## end function clean.name()
Added: trunk/rkward/packages/rkwarddev/R/rk.JS.array.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.JS.array.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.JS.array.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,57 @@
+#' Create a simple JavaScript array
+#'
+#' If you need to combine multiple options (like values of several checkboxes) into one vector or list,
+#' this function can help with that task. All relevant variables will become part of an array and
+#' then joined into the desired argument type.
+#'
+#' @param option A character string, naming the option of, e.g., an R function which should be
+#' constructed from several variables.
+#' @param variables A character vector, the names of the variables to combine to a vector or list.
+#' @param list Logical, if \code{TRUE} the option will be constructed by \code{list()},
+#' otherwise by \code{c()}.
+#' @param def.vars Logical, if \code{TRUE} the provided variables will also be defined.
+#' @param var.prefix A character string. If \code{def.vars=TRUE}, this string will be used as a prefix
+#' for the JS variable names.
+#' @param indent.by A character string defining how indentation should be done.
+#' @return A character string.
+#' @export
+#' @examples
+#' cat(rk.JS.array("my.option", variables=c("frst.var", "scnd.var")))
+
+rk.JS.array <- function(option, variables=NULL, list=FALSE, def.vars=TRUE, var.prefix="chc", indent.by="\t"){
+ arr.name <- camelCode(c("arr", option))
+ opt.name <- camelCode(c("opt", option))
+
+ if(isTRUE(def.vars)){
+ JS.vars <- paste(unlist(sapply(variables, function(this.var){get.JS.vars(
+ JS.var=this.var,
+ XML.var=this.var,
+ JS.prefix=var.prefix,
+ indent.by=indent.by)
+ })), collapse="")
+ } else {
+ JS.vars <- ""
+ }
+
+ JS.array <- paste(
+ indent(2, by=indent.by), "var ", arr.name, " = new Array();\n",
+ indent(2, by=indent.by), arr.name, ".push(",
+ paste(unlist(sapply(variables, function(this.var){get.JS.vars(
+ JS.var=this.var,
+ JS.prefix=var.prefix,
+ names.only=TRUE)
+ })), collapse=", "), ");\n",
+ indent(2, by=indent.by), arr.name, " = ", arr.name, ".filter(String);\n",
+ indent(2, by=indent.by), "if(", arr.name, ".length > 0) {\n",
+ indent(3, by=indent.by), "var ", opt.name, " = \", ", option,"=",
+ ifelse(isTRUE(list), "list(", "c("),
+ "\" + ", arr.name, ".join(\", \") + \")\";\n",
+ indent(2, by=indent.by), "} else {\n",
+ indent(3, by=indent.by), "var ", opt.name, " = \"\";\n",
+ indent(2, by=indent.by), "}\n",
+ sep="")
+
+ results <- paste(JS.vars, JS.array, sep="\n")
+
+ return(results)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.JS.doc.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.JS.doc.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.JS.doc.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,47 @@
+#' Create JavaScript outline from RKWard plugin XML
+#'
+#' @note The JavaScript
+#'
+#' @param require A character vector with names of R packages that the dialog depends on.
+#' @param variables A character string to be included to read in all needed variables from the dialog.
+#' Refer to \code{\link{rk.JS.scan}} for a function to create this from an existing plugin XML file.
+#' @param results.header A character string to headline the printed results.
+#' @param preprocess A character string to be included in the \code{preprocess()} function. This string will be
+#' pasted as-is, after \code{require} has been evaluated.
+#' @param calculate A character string to be included in the \code{calculate()} function. This string will be
+#' pasted as-is, after \code{variables} has been evaluated.
+#' @param printout A character string to be included in the \code{printout()} function. This string will be
+#' pasted as-is, after \code{results.header} has been evaluated.
+#' @param indent.by A character string defining how indentation should be done.
+#' @return A character string.
+#' @export
+
+rk.JS.doc <- function(require=c(), variables=NULL, results.header=NULL,
+ preprocess=NULL, calculate=NULL, printout=NULL, indent.by="\t"){
+
+ js.require <- unlist(sapply(require, function(this.req){
+ paste(indent(2, by=indent.by), "echo(\"require(", this.req, ")\\n\");", sep="")
+ }))
+ js.preprocess <- paste("function preprocess(){\n",
+ indent(2, by=indent.by), "// add requirements etc. here.\n",
+ paste(js.require, collapse="\n"), "\n",
+ ifelse(is.null(preprocess), "", preprocess),
+ "\n}", sep="")
+
+ js.calculate <- paste("function calculate(){\n",
+ indent(2, by=indent.by), "// read in variables from dialog\n",
+ paste(variables, collapse=""), "\n",
+ indent(2, by=indent.by), "// put the R code to be evaluated here.\n",
+ ifelse(is.null(calculate), "", calculate),
+ "\n}", sep="")
+
+ js.printout <- paste("function printout(){\n",
+ indent(2, by=indent.by), "// printout the results\n",
+ indent(2, by=indent.by), "echo(\"rk.header(\\\"", results.header,"\\\", level=2)\\n\");\n",
+ ifelse(is.null(printout), paste(indent(2, by=indent.by), "echo(\"rk.print(\\\"\\\")\\n\");", sep=""), printout),
+ "\n}", sep="")
+
+ JS.doc <- paste(js.preprocess, js.calculate, js.printout, sep="\n\n")
+
+ return(JS.doc)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.JS.scan.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.JS.scan.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.JS.scan.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,43 @@
+#' Create JavaScript variables from plugin XML
+#'
+#' @param pXML Either an object of class \code{XiMpLe.doc} or \code{XiMpLe.node}, or path to a plugin XML file.
+#' @param js Logical, if \code{TRUE} usable JavaScript code will be returned, otherwise a character
+#' vector with only the relevant ID names.
+#' @param add.abbrev Logical, if \code{TRUE} the JavaScript variables will all have a prefix with an
+#' three letter abbreviation of the XML tag type to improve the readability of the code. But it's
+#' probably better to add this in the XML code in the first place.
+#' @param indent.by Character string used to indent each entry if \code{js=TRUE}.
+#' @return A character vector.
+#' @export
+
+rk.JS.scan <- function(pXML, js=TRUE, add.abbrev=FALSE, indent.by="\t"){
+
+ JS.relevant.tags <- c("radio", "varslot", "browser", "dropdown",
+ "checkbox", "saveobject", "input", "spinbox")
+
+ single.tags <- get.single.tags(XML.obj=pXML, drop=c("comments","cdata", "declarations", "doctype"))
+
+ JS.id <- get.IDs(single.tags=single.tags, relevant.tags=JS.relevant.tags, add.abbrev=add.abbrev)
+
+ if("id" %in% colnames(JS.id)){
+ if(isTRUE(js)){
+ # now
+ # <tag id="my.id" ...>
+ # will become
+ # var my.id = getValue("my.id");
+ JS.lines <- paste(unlist(sapply(1:nrow(JS.id), function(this.id){
+ return(get.JS.vars(
+ JS.var=JS.id[this.id,"abbrev"],
+ XML.var=JS.id[this.id,"id"],
+ indent.by=indent.by))
+ })), collapse="")
+ } else {
+ JS.lines <- JS.id[,"id"]
+ names(JS.lines) <- NULL
+ }
+ } else {
+ JS.lines <- NULL
+ }
+
+ return(JS.lines)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.XML.about.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.about.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.about.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,249 @@
+#' Create XML node "about" for RKWard pluginmaps
+#'
+#' @param name A character string with the plugin name.
+#' @param author A vector of objects of class \code{person} with these elements (mandatory):
+#' \describe{
+#' \item{given}{Author given name}
+#' \item{family}{Author family name}
+#' \item{email}{Author mail address}
+#' \item{role}{This person's specific role, e.g. \code{"aut"} for actual author, \code{"cre"} for maintainer or \code{"ctb"} for contributor.}
+#' }
+#' See \code{\link[utils:person]{person}} for more details on this, especially for valid roles.
+#' @param about A named list with these elements:
+#' \describe{
+#' \item{desc}{A short description (mandatory)}
+#' \item{version}{Plugin version (mandatory)}
+#' \item{date}{Release date (mandatory)}
+#' \item{url}{URL for the plugin (optional)}
+#' \item{license}{License the plugin is distributed under (mandatory)}
+#' \item{category}{A category for this plugin (optional)}
+#' }
+#' @param dependencies A named list with these elements:
+#' \describe{
+#' \item{rkward.min}{Minimum RKWard version needed for this plugin (optional)}
+#' \item{rkward.max}{Maximum RKWard version needed for this plugin (optional)}
+#' \item{R.min}{Minimum R version needed for this plugin (optional)}
+#' \item{R.max}{Maximum R version needed for this plugin (optional)}
+#' }
+#' @param package A list of named character vectors, each with these elements:
+#' \describe{
+#' \item{name}{Name of a package this plugin depends on (optional)}
+#' \item{min}{Minimum version of the package (optional)}
+#' \item{max}{Maximum version of the package (optional)}
+#' \item{repository}{Repository to download the package (optional)}
+#' }
+#' @param pluginmap A named list with these elements:
+#' \describe{
+#' \item{name}{Identifier of a pluginmap this plugin depends on (optional)}
+#' \item{url}{URL to get the pluginmap (optional)}
+#' }
+#' @export
+#' @examples
+#' about.node <- rk.XML.about(
+#' name="Square the circle",
+#' author=c(
+#' person(given="E.A.", family="Dölle",
+#' email="doelle@@eternalwondermaths.example.org", role="aut"),
+#' person(given="A.", family="Assistant",
+#' email="alterego@@eternalwondermaths.example.org", role=c("cre","ctb"))
+#' ),
+#' about=list(
+#' desc="Squares the circle using Heisenberg compensation.",
+#' version="0.1-3",
+#' date=Sys.Date(),
+#' url="http://eternalwondermaths.example.org/23/stc.html",
+#' license="GPL",
+#' category="Geometry"),
+#' dependencies=list(
+#' rkward.min="0.5.3",
+#' rkward.max="",
+#' R.min="2.10",
+#' R.max=""),
+#' package=list(
+#' c(name="heisenberg", min="0.11-2", max="",
+#' repository="http://rforge.r-project.org"),
+#' c(name="DreamsOfPi", min="0.2", max="", repository="")),
+#' pluginmap=list(
+#' c(name="heisenberg.pluginmap", url="http://eternalwondermaths.example.org/hsb"))
+#' )
+#'
+#' cat(pasteXMLNode(about.node, shine=2))
+
+
+rk.XML.about <- function(name, author, about=list(desc="SHORT_DESCRIPTION", version="0.01-0", date=Sys.Date(), url="http://EXAMPLE.com", license="GPL (>= 3)"), dependencies=NULL, package=NULL, pluginmap=NULL){
+ # sanity checks
+ stopifnot(all(length(name), length(author)) > 0)
+ if(is.null(about)){
+ about <- list()
+ } else {}
+ if(!"desc" %in% names(about)){
+ about[["desc"]] <- "SHORT_DESCRIPTION"
+ } else {}
+ if(!"version" %in% names(about)){
+ about[["version"]] <- "0.01-0"
+ } else {}
+ if(!"date" %in% names(about)){
+ about[["date"]] <- Sys.Date()
+ } else {}
+ if(!"url" %in% names(about)){
+ about[["url"]] <- "http://EXAMPLE.com"
+ } else {}
+ if(!"license" %in% names(about)){
+ about[["license"]] <- "GPL (>= 3)"
+ } else {}
+
+ ## author
+ # - given
+ # - family
+ # - email
+ # - role
+ xml.authors <- unlist(sapply(author, function(this.author){
+ stopifnot(all(c("given", "family", "email") %in% names(unlist(this.author))))
+ author.given <- format(this.author, include="given")
+ author.family <- format(this.author, include="family")
+ author.email <- format(this.author, include="email", braces=list(email=""))
+ author.role <- format(this.author, include="role", braces=list(role=""), collapse=list(role=", "))
+ result <- new("XiMpLe.node",
+ name="author",
+ attributes=list(given=author.given, family=author.family, email=author.email, role=author.role))
+ return(result)
+ }))
+
+ ## package
+ # - name
+ # - min="min_version",
+ # - max="max_version",
+ # - repository
+ # create example, if empty
+ if(is.null(package)){
+ xml.package.example <- new("XiMpLe.node",
+ name="package",
+ attributes=list(
+ name="CHANGE_ME_OR_DELETE_ME",
+ "min_version"="CHANGE_ME_OR_DELETE_ME",
+ "max_version"="CHANGE_ME_OR_DELETE_ME",
+ repository="CHANGE_ME_OR_DELETE_ME"
+ ))
+ xml.package <- list(new("XiMpLe.node",
+ name="!--",
+ children=list(xml.package.example)
+ ))
+ } else {
+ xml.package <- sapply(package, function(this.package){
+ result <- new("XiMpLe.node",
+ name="package",
+ attributes=list(
+ name=this.package[["name"]],
+ "min_version"=this.package[["min"]],
+ "max_version"=this.package[["max"]],
+ repository=this.package[["repository"]]
+ ))
+ return(result)
+ })
+ }
+
+ ## pluginmap
+ # - name,
+ # - url
+ # create example, if empty
+ if(is.null(pluginmap)){
+ xml.pluginmap.text <- new("XiMpLe.node",
+ name="",
+ value="If this plugin depends on other pluginmaps, edit this part to your needs:"
+ )
+ xml.pluginmap.example <- new("XiMpLe.node",
+ name="pluginmap",
+ attributes=list(
+ name="CHANGE_ME_OR_DELETE_ME",
+ url="CHANGE_ME_OR_DELETE_ME"
+ )
+ )
+ xml.pluginmap <- list(new("XiMpLe.node",
+ name="!--",
+ children=list(xml.pluginmap.text, xml.pluginmap.example)
+ ))
+ } else {
+ xml.pluginmap <- sapply(pluginmap, function(this.pluginmap){
+ result <- new("XiMpLe.node",
+ name="pluginmap",
+ attributes=list(
+ name=this.pluginmap[["name"]],
+ url=this.pluginmap[["url"]]
+ ))
+ return(result)
+ })
+ }
+
+ ## dependencies
+ # - rkward.min="rkward_min_version",
+ # - rkward.max="rkward_max_version",
+ # - R.min="R_min_verion",
+ # - R.max="R_max_verion"
+ # + package
+ # + pluginmap
+ for (pmap in xml.pluginmap){
+ xml.package[[length(xml.package)+1]] <- pmap
+ }
+ # comment out an example dependency listing if it has no entries
+ if(is.null(dependencies)){
+ R.v <- R.Version()
+ xml.dependencies.text <- new("XiMpLe.node",
+ name="!--",
+ value="If this plugin has dependencies, edit this part to your needs:"
+ )
+ xml.authors[[length(xml.authors)+1]] <- xml.dependencies.text
+ xml.dependencies <- new("XiMpLe.node",
+ name="dependencies",
+ attributes=list(
+ "rkward_min_version"=.rk.app.version,
+ "rkward_max_version"="CHANGE_ME_OR_DELETE_ME",
+ "R_min_verion"=paste(R.v$major, R.v$minor, sep="."),
+ "R_max_verion"="CHANGE_ME_OR_DELETE_ME"
+ ),
+ children=xml.package,
+ value=""
+ )
+ } else {
+ xml.dependencies <- new("XiMpLe.node",
+ name="dependencies",
+ attributes=list(
+ "rkward_min_version"=dependencies[["rkward.min"]],
+ "rkward_max_version"=dependencies[["rkward.max"]],
+ "R_min_verion"=dependencies[["R.min"]],
+ "R_max_verion"=dependencies[["R.max"]]
+ ),
+ children=xml.package,
+ value=""
+ )
+ }
+
+ ## about
+ # - name
+ # - desc="shortinfo",
+ # - version
+ # - date="releasedate",
+ # - url
+ # - license
+ # - category
+ # + authors
+ # + dependencies
+ xml.authors[[length(xml.authors)+1]] <- xml.dependencies
+ if(is.null(xml.authors)){
+ xml.authors <- list()
+ } else {}
+ xml.about <- new("XiMpLe.node",
+ name="about",
+ attributes=list(
+ name=name,
+ "shortinfo"=about[["desc"]],
+ version=about[["version"]],
+ "releasedate"=about[["date"]],
+ url=about[["url"]],
+ license=about[["license"]],
+ category=about[["category"]]
+ ),
+ children=xml.authors
+ )
+
+ return(xml.about)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.XML.attribute.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.attribute.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.attribute.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,42 @@
+#' Create XML "attribute" node for RKWard plugins
+#'
+#' This function will create a attribute node for component sections in .pluginmap files.
+#' Only meaningful for import plugins.
+#'
+#' @param id Either a character string (the \code{id} of the property whose attribute should be set),
+#' or an object of class \code{XiMpLe.node} (whose \code{id} will be extracted and used).
+#' @param value Character string, new value for the attribute.
+#' @param label Character string, label associated with the attribute.
+#' @return A list of objects of class \code{XiMpLe.node}.
+#' @export
+#' @seealso
+#' \code{\link[rkwarddev:rk.XML.components]{rk.XML.components}}
+#' @examples
+#' # define a formula section with varselector and varslots
+#' test.checkbox <- rk.XML.cbox(label="foo", value="foo1", chk=TRUE)
+#' # re-set the attribute
+#' test.attribute <- rk.XML.attribute(test.checkbox, value="bar2", label="bar")
+#' cat(pasteXMLNode(test.attribute))
+
+rk.XML.attribute <- function(id, value=NULL, label=NULL){
+ # let's see if we need to extract IDs first
+ attr.list <- list(id=check.ID(id))
+
+ if(all(is.null(value), is.null(label))){
+ stop(simpleError("You must at least specity either one of 'value' or 'label'!"))
+ } else {}
+
+ if(!is.null(value)){
+ attr.list[["value"]] <- value
+ } else {}
+ if(!is.null(label)){
+ attr.list[["label"]] <- label
+ } else {}
+
+ node <- new("XiMpLe.node",
+ name="attribute",
+ attributes=attr.list
+ )
+
+ return(node)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.XML.browser.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.browser.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.browser.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,51 @@
+#' Create XML node "browser" for RKWard plugins
+#'
+#' @param label Character string, a text label for this plugin element.
+#' @param type Character string, valid values are "dir", "file" and "savefile" (i.e., an non-existing file).
+#' @param initial Character string, if not \code{NULL} will be used as the initial value of the browser.
+#' @param urls Logical, whether non-local URLs are permitted or not.
+#' @param filter Character vector, file type filter, e.g. \code{filter=c("*.txt", "*.csv")} for .txt and .csv files.
+#' Try not to induce limits unless absolutely needed, though.
+#' @param required Logical, whether an entry is mandatory or not.
+#' @param id.name Character string, a unique ID for this plugin element.
+#' If \code{"auto"} and a label was provided, an ID will be generated automatically from the label.
+#' @return An object of class \code{XiMpLe.node}.
+#' @export
+#' @examples
+#' test.browser <- rk.XML.browser("Browse here:")
+#' cat(pasteXMLNode(test.browser))
+
+
+rk.XML.browser <- function(label, type="file", initial=NULL, urls=FALSE, filter=NULL, required=FALSE, id.name="auto"){
+ attr.list <- list(label=label)
+
+ if(length(type) == 1 & type %in% c("dir", "file", "savefile")){
+ attr.list[["type"]] <- type
+ } else {
+ stop(simpleError(paste("Unknown browser type: ", type, sep="")))
+ }
+
+ if(identical(id.name, "auto")){
+ attr.list[["id"]] <- auto.ids(label, prefix=ID.prefix("browser"))
+ } else if(!is.null(id.name)){
+ attr.list[["id"]] <- id.name
+ } else {}
+ if(!is.null(initial)){
+ attr.list[["initial"]] <- initial
+ } else {}
+ if(isTRUE(urls)){
+ attr.list[["allow_urls"]] <- "true"
+ } else {}
+ if(!is.null(filter)){
+ attr.list[["filter"]] <- paste(filter, collapse=" ")
+ } else {}
+ if(isTRUE(required)){
+ attr.list[["required"]] <- "true"
+ } else {}
+
+ node <- new("XiMpLe.node",
+ name="browser",
+ attributes=attr.list)
+
+ return(node)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.XML.cbox.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.cbox.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.cbox.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,38 @@
+#' Create XML node "checkbox" for RKWard plugins
+#'
+#' @param label Character string, a text label for this plugin element.
+#' @param value Character string, the value to submit if the element is checked.
+#' @param un.value Character string, an optional value for the unchecked option.
+#' @param chk Logical, whether this element should be checked by default.
+#' @param id.name Character string, a unique ID for this plugin element.
+#' If \code{"auto"}, an ID will be generated automatically from the label.
+#' @return An object of class \code{XiMpLe.node}.
+#' @export
+#' @examples
+#' test.checkboxes <- rk.XML.row(rk.XML.col(
+#' list(
+#' rk.XML.cbox(label="foo", value="foo1", chk=TRUE),
+#' rk.XML.cbox(label="bar", value="bar2"))))
+#' cat(pasteXMLNode(test.checkboxes))
+
+rk.XML.cbox <- function(label, value, un.value=NULL, chk=FALSE, id.name="auto"){
+ if(identical(id.name, "auto")){
+ id <- auto.ids(label, prefix=ID.prefix("checkbox"))
+ } else {
+ id <- id.name
+ }
+
+ attr.list <- list(id=id, label=label, value=value)
+ if(!is.null(un.value)){
+ attr.list[["unchecked_value"]] <- un.value
+ } else {}
+ if(isTRUE(chk)){
+ attr.list[["checked"]] <- "true"
+ } else {}
+
+ checkbox <- new("XiMpLe.node",
+ name="checkbox",
+ attributes=attr.list)
+
+ return(checkbox)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.XML.col.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.col.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.col.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,29 @@
+#' Create XML node "column" for RKWard plugins
+#'
+#' @param children An optional list with objects of class \code{XiMpLe.node}.
+#' @param id.name Character string, a unique ID for this plugin element.
+#' If \code{NULL}, no ID will be given.
+#' @return An object of class \code{XiMpLe.node}.
+#' @export
+#' @examples
+#' test.checkboxes <- rk.XML.row(rk.XML.col(
+#' list(
+#' rk.XML.cbox(label="foo", val="foo1", chk=TRUE),
+#' rk.XML.cbox(label="bar", val="bar2"))))
+#' cat(pasteXMLNode(test.checkboxes))
+
+rk.XML.col <- function(children=list(), id.name=NULL){
+ if(!is.null(id.name)){
+ attr.list <- list(id=id.name)
+ } else {
+ attr.list <- list()
+ }
+
+ col <- new("XiMpLe.node",
+ name="column",
+ attributes=attr.list,
+ children=child.list(children),
+ value="")
+
+ return(col)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.XML.component.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.component.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.component.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,44 @@
+#' Create XML "component" node for RKWard plugins
+#'
+#' This function will create a component node for components sections of .pluginmap files.
+#'
+#' @param label Character string, a label for the component.
+#' @param file Character string, file name of a plugin XML file defining the GUI.
+#' @param id.name Character string, a unique ID for this plugin element.
+#' If \code{"auto"}, an ID will be generated automatically from the label.
+#' @param type Character string, type of component. As of now, only "standard" is supported. The option is
+#' just implemented for completeness.
+#' @return A list of objects of class \code{XiMpLe.node}.
+#' @export
+#' @seealso
+#' \code{\link[rkwarddev:rk.XML.components]{rk.XML.components}}
+#' @examples
+#' test.component <- rk.XML.component("My GUI dialog", "plugins/MyGUIdialog.xml")
+#' cat(pasteXMLNode(test.component))
+
+rk.XML.component <- function(label, file, id.name="auto", type="standard"){
+ if(identical(id.name, "auto")){
+ # try autogenerating some id
+ id.name <- auto.ids(label, prefix=ID.prefix("component"), chars=10)
+ } else if(is.null(id.name)){
+ stop(simpleError("Components need an ID!"))
+ } else {}
+ attr.list <- list(id=check.ID(id.name), label=label)
+
+ # once there are more types supported, this will make much more sense...
+ if(!type %in% c("standard")){
+ stop(simpleError(paste("Invalid type: ", type, sep="")))
+ } else {
+ attr.list[["type"]] <- type
+ }
+ if(!is.null(file)){
+ attr.list[["file"]] <- file
+ } else {}
+
+ node <- new("XiMpLe.node",
+ name="component",
+ attributes=attr.list
+ )
+
+ return(node)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.XML.components.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.components.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.components.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,31 @@
+#' Create XML "components" node for RKWard plugins
+#'
+#' This function will create a components node for a .pluginmap file, with mandatory child nodes "component".
+#'
+#' @param nodes A (list of) objects of class \code{XiMpLe.node}. They must all have the name "component".
+#' @return A list of objects of class \code{XiMpLe.node}.
+#' @export
+#' @seealso
+#' \code{\link[rkwarddev:rk.XML.pluginmap]{rk.XML.pluginmap}},
+#' \code{\link[rkwarddev:rk.XML.component]{rk.XML.component}}
+#' @examples
+#' test.component <- rk.XML.component("My GUI dialog", "plugins/MyGUIdialog.xml")
+#' test.components <- rk.XML.components(test.component)
+#' cat(pasteXMLNode(test.components))
+
+rk.XML.components <- function(nodes){
+ # check the node names and allow only valid ones
+ sapply(child.list(nodes), function(this.node){
+ node.name <- this.node at name
+ if(!identical(node.name, "component")){
+ stop(simpleError(paste("Invalid XML nodes for components section: ", node.name, sep="")))
+ } else {}
+ })
+
+ node <- new("XiMpLe.node",
+ name="components",
+ children=child.list(nodes)
+ )
+
+ return(node)
+}
Added: trunk/rkward/packages/rkwarddev/R/rk.XML.connect.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.XML.connect.R (rev 0)
+++ trunk/rkward/packages/rkwarddev/R/rk.XML.connect.R 2011-10-02 17:05:43 UTC (rev 3874)
@@ -0,0 +1,70 @@
+#' Create XML node "connect" for RKWard plugins
+#'
+#' If you define a \code{XiMpLe.node} object as \code{governor} which is not a \code{<convert>} node
+#' and \code{not=FALSE}, the function will automatically append ".state" to its \code{id}.
+#'
+#' @param governor Either a character string (the \code{id} of the property whose state should control
+#' the \code{client}), or an object of class \code{XiMpLe.node} (whose \code{id} will be extracted
+#' and used). Usually a \code{<convert>} node defined earlier (see
@@ Diff output truncated at 100000 characters. @@
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
More information about the rkward-tracker
mailing list