[rkward-cvs] SF.net SVN: rkward:[3726] trunk/rkward/rkward/rbackend/rpackages
m-eik at users.sourceforge.net
m-eik at users.sourceforge.net
Mon Sep 5 11:34:52 UTC 2011
Revision: 3726
http://rkward.svn.sourceforge.net/rkward/?rev=3726&view=rev
Author: m-eik
Date: 2011-09-05 11:34:51 +0000 (Mon, 05 Sep 2011)
Log Message:
-----------
initially merged R packages rkwarddev and XiMpLe into svn tree
Added Paths:
-----------
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/ChangeLog
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/DESCRIPTION
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/NAMESPACE
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-internal.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-internal.roxy.all.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-package.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe.doc-class.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe.node-class.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/node.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/parseXMLTree.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLNode.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLTag.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLTree.R
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/inst/
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/inst/CITATION
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/XiMpLe-package.Rd
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/node.Rd
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/parseXMLTree.Rd
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLNode.Rd
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLTag.Rd
trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLTree.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/ChangeLog
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/DESCRIPTION
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/NAMESPACE
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk-internal.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.JS.doc.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.JS.scan.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.about.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.cbox.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.col.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.dropdown.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.frame.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.plugin.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.pluginmap.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.radio.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.row.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.tabbook.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.vars.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.plugin.skeleton.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.rkh.doc.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.rkh.scan.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rkwarddev-desc-internal.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rkwarddev-package.R
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/inst/
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/inst/CITATION
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.JS.doc.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.JS.scan.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.about.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.cbox.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.col.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.dropdown.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.frame.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.plugin.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.pluginmap.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.radio.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.row.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.tabbook.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.XML.vars.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.plugin.skeleton.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.rkh.doc.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rk.rkh.scan.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwarddev/man/rkwarddev-package.Rd
Added: trunk/rkward/rkward/rbackend/rpackages/XiMpLe/ChangeLog
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/ChangeLog (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/ChangeLog 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,44 @@
+ChangeLog for package XiMpLe
+
+## 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/rkward/rbackend/rpackages/XiMpLe/DESCRIPTION
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/DESCRIPTION (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/DESCRIPTION 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,34 @@
+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
+Author at R: c(person(given="Meik", family="Michalke",
+ email="meik.michalke at hhu.de"))
+Version: 0.02-2
+Date: 2011-09-02
+Collate:
+ 'XiMpLe.node-class.R'
+ 'XiMpLe.doc-class.R'
+ 'node.R'
+ 'parseXMLTree.R'
+ 'pasteXMLNode.R'
+ 'pasteXMLTag.R'
+ 'pasteXMLTree.R'
+ 'XiMpLe-internal.R'
+ 'XiMpLe-internal.roxy.all.R'
+ 'XiMpLe-package.R'
Added: trunk/rkward/rkward/rbackend/rpackages/XiMpLe/NAMESPACE
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/NAMESPACE (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/NAMESPACE 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,9 @@
+exportClasses(XiMpLe.doc)
+exportClasses(XiMpLe.node)
+exportMethods(node)
+exportMethods("node<-")
+export(parseXMLTree)
+export(pasteXMLNode)
+export(pasteXMLTag)
+export(pasteXMLTree)
+import(methods)
Added: trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-internal.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-internal.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,444 @@
+## 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",
+ value=this.tag)
+ 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)
+ # if there's a value element, move the value here
+ if(!is.null(rec.nodes$children[["value"]])){
+ node.value <- rec.nodes$children[["value"]]@value
+ rec.nodes$children[["value"]] <- NULL
+ } else {
+ # this will force the node to remain non-empty.
+ # if value was character() and node had no children,
+ # it would be turned into an empty tag otherwise
+ node.value <- ""
+ }
+ children[nxt.child] <- new("XiMpLe.node",
+ name=child.name,
+ attributes=child.attr,
+ children=rec.nodes$children,
+ value=as.character(node.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/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-internal.roxy.all.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-internal.roxy.all.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-internal.roxy.all.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,19 @@
+# package description 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>",
+ AuthorR="c(person(given=\"Meik\", family=\"Michalke\", email=\"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",
+ stringsAsFactors=FALSE)
Added: trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-package.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-package.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe-package.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,28 @@
+#' A simple XML tree parser and generator.
+#'
+#' \tabular{ll}{
+#' Package: \tab XiMpLe\cr
+#' Type: \tab Package\cr
+#' Version: \tab 0.02-2\cr
+#' Date: \tab 2011-09-02\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/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe.doc-class.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe.doc-class.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe.doc-class.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,46 @@
+#' @include XiMpLe.node-class.R
+#' @import methods
+#' @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/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe.node-class.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe.node-class.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/XiMpLe.node-class.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,45 @@
+#' @import methods
+#' @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(!nchar(obj.name) > 0){
+ print(str(object))
+ stop(simpleError("Invalid object: A node must have a name!"))
+ } 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/rkward/rbackend/rpackages/XiMpLe/R/node.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/node.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/node.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -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/rkward/rbackend/rpackages/XiMpLe/R/parseXMLTree.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/parseXMLTree.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/parseXMLTree.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -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/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLNode.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLNode.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLNode.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,51 @@
+#' 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=2, indent.by="\t"){
+ if(!inherits(node, "XiMpLe.node")){
+ 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
+ }
+
+ if(length(node.val) > 0){
+ node.empty <- FALSE
+ if(nchar(node.val) > 0){
+ node.chld <- paste(new.indent, node.val, new.node, node.chld, collapse="", 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/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLTag.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLTag.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLTag.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,61 @@
+#' 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), "")
+
+ # two special cases: comments and CDATA
+ 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/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLTree.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLTree.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/R/pasteXMLTree.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,53 @@
+#' 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=2, indent.by="\t"){
+ if(!inherits(obj, "XiMpLe.doc")){
+ 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="", collapse=" "), 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/rkward/rbackend/rpackages/XiMpLe/inst/CITATION
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/inst/CITATION (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/inst/CITATION 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,14 @@
+bibentry("Manual",
+ title="XiMpLe: A simple XML tree parser and generator",
+ author=c(person(given="Meik", family="Michalke", email="meik.michalke at hhu.de")),
+ year="2011",
+ note="(Version 0.02-2)",
+ url="http://rkward.sourceforge.net",
+
+ textVersion =
+ paste("Michalke, M. (2011). ",
+ "XiMpLe: A simple XML tree parser and generator (Version 0.02-2). ",
+ "Available from http://rkward.sourceforge.net",
+ sep=""),
+
+ mheader = "To cite XiMpLe in publications use:")
Added: trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/XiMpLe-package.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/XiMpLe-package.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/XiMpLe-package.Rd 2011-09-05 11:34:51 UTC (rev 3726)
@@ -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.02-2\cr Date: \tab
+ 2011-09-02\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/rkward/rbackend/rpackages/XiMpLe/man/node.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/node.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/node.Rd 2011-09-05 11:34:51 UTC (rev 3726)
@@ -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/rkward/rbackend/rpackages/XiMpLe/man/parseXMLTree.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/parseXMLTree.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/parseXMLTree.Rd 2011-09-05 11:34:51 UTC (rev 3726)
@@ -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/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLNode.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLNode.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLNode.Rd 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,25 @@
+\name{pasteXMLNode}
+\alias{pasteXMLNode}
+\title{Paste an XML node from a XiMpLe.node object}
+\usage{
+ pasteXMLNode(node, level = 1, shine = 2, 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/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLTag.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLTag.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLTag.Rd 2011-09-05 11:34:51 UTC (rev 3726)
@@ -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/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLTree.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLTree.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/XiMpLe/man/pasteXMLTree.Rd 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,22 @@
+\name{pasteXMLTree}
+\alias{pasteXMLTree}
+\title{Paste an XML tree structure from a XiMpLe.doc object}
+\usage{
+ pasteXMLTree(obj, shine = 2, 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/rkward/rbackend/rpackages/rkwarddev/ChangeLog
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/ChangeLog (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/ChangeLog 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,14 @@
+ChangeLog for package rkwardplugdev
+
+## 0.01-1 (2011-09-05)
+ - added rk.JS.scan(), rk.JS.doc(), rk.rkh.scan() and rk.rkh.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/rkward/rbackend/rpackages/rkwarddev/DESCRIPTION
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/DESCRIPTION (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/DESCRIPTION 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,39 @@
+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
+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
+Author at R: c(person(given="Meik", family="Michalke",
+ email="meik.michalke at hhu.de"))
+Version: 0.01-1
+Date: 2011-09-05
+Collate:
+ 'rk-internal.R'
+ 'rk.JS.doc.R'
+ 'rk.JS.scan.R'
+ 'rk.plugin.skeleton.R'
+ 'rk.rkh.doc.R'
+ 'rk.rkh.scan.R'
+ 'rkwarddev-desc-internal.R'
+ 'rkwarddev-package.R'
+ 'rk.XML.about.R'
+ 'rk.XML.cbox.R'
+ 'rk.XML.col.R'
+ 'rk.XML.dropdown.R'
+ 'rk.XML.frame.R'
+ 'rk.XML.pluginmap.R'
+ 'rk.XML.plugin.R'
+ 'rk.XML.radio.R'
+ 'rk.XML.row.R'
+ 'rk.XML.tabbook.R'
+ 'rk.XML.vars.R'
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/NAMESPACE
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/NAMESPACE (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/NAMESPACE 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,16 @@
+export(rk.JS.doc)
+export(rk.JS.scan)
+export(rk.plugin.skeleton)
+export(rk.rkh.doc)
+export(rk.rkh.scan)
+export(rk.XML.about)
+export(rk.XML.cbox)
+export(rk.XML.col)
+export(rk.XML.dropdown)
+export(rk.XML.frame)
+export(rk.XML.plugin)
+export(rk.XML.pluginmap)
+export(rk.XML.radio)
+export(rk.XML.row)
+export(rk.XML.tabbook)
+export(rk.XML.vars)
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk-internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk-internal.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk-internal.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,105 @@
+# internal functions for the rk.* functions
+
+auto.ids <- function(identifiers, prefix=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, 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.abbrev <- abbreviate(this.tag.name, minlength=3, strict=TRUE)
+ this.tag.id.abbrev <- paste(this.tag.abbrev, ".", 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(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()
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.JS.doc.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.JS.doc.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.JS.doc.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,32 @@
+#' Create JavaScript outline from RKWard plugin XML
+#'
+#' @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 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, 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}", 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), "// create the R code to be evaluated here\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",
+ indent(2, by=indent.by), "echo(\"rk.print(\\\"\\\")\\n\");\n}", sep="")
+
+ JS.doc <- paste(js.preprocess, js.calculate, js.printout, sep="\n\n")
+
+ return(JS.doc)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.JS.scan.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.JS.scan.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.JS.scan.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,40 @@
+#' 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(paste(indent.by, "var ", camelCode(JS.id[this.id,"abbrev"]), " = getValue(\"", JS.id[this.id,"id"], "\");\n", sep=""))
+ })), collapse="")
+ } else {
+ JS.lines <- JS.id[,"id"]
+ names(JS.lines) <- NULL
+ }
+ } else {
+ JS.lines <- NULL
+ }
+
+ return(JS.lines)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.about.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.about.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.about.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,182 @@
+#' Create XML node "about" for RKWard pluginmaps
+#'
+#' @param about A named list with these elements:
+#' \describe{
+#' \item{name} {Plugin name}
+#' \item{desc} {A short description}
+#' \item{version} {Plugin version}
+#' \item{date} {Release date}
+#' \item{url} {URL for the plugin}
+#' \item{license} {License the plugin is distributed under}
+#' \item{category} {An optional category}
+#' }
+#' @param author A list of named character vectors with these elements:
+#' \describe{
+#' \item{name} {Full author name}
+#' \item{email} {Author mail address}
+#' \item{url} {Author homepage}
+#' }
+#' @param dependencies A named list with these elements:
+#' \describe{
+#' \item{rkward.min} {Minimum RKWard version needed for this plugin}
+#' \item{rkward.max} {Maximum RKWard version needed for this plugin}
+#' \item{R.min} {Minimum R version needed for this plugin}
+#' \item{R.max} {Maximum R version needed for this plugin}
+#' }
+#' @param package A list of named character vectors, each with these elements:
+#' \describe{
+#' \item{name} {Name of a package this plugin depends on}
+#' \item{min} {Minimum version of the package}
+#' \item{max} {Maximum version of the package}
+#' \item{repository} {Repository to download the package}
+#' }
+#' @param pluginmap A named list with these elements:
+#' \describe{
+#' \item{name} {Identifier of a pluginmap this plugin depends on}
+#' \item{url} {URL to get the pluginmap}
+#' }
+#' @export
+#' @examples
+#' about.node <- rk.XML.about(
+#' about=list(
+#' name="Square the circle",
+#' 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"),
+#' author=list(
+#' c(name="E.A. Dölle", email="doelle@@eternalwondermaths.example.org",
+#' url="http://eternalwondermaths.example.org"),
+#' c(name="A. Assistant", email="alterego@@eternalwondermaths.example.org",
+#' url="http://eternalwondermaths.example.org/staff/")
+#' ),
+#' 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))
+
+
+rk.XML.about <- function(about, author, dependencies=NULL, package=NULL, pluginmap=NULL){
+ # sanity checks
+ stopifnot(all(c("name", "desc", "version", "date", "license") %in% names(about)))
+ stopifnot(all(length(about[c("name", "desc", "version", "date", "license")]) > 0))
+
+ ## author
+ # - name
+ # - email
+ # - url
+ xml.authors <- unlist(sapply(author, function(this.author){
+ author.name <- this.author[["name"]]
+ author.email <- this.author[["email"]]
+ author.url <- this.author[["url"]]
+ result <- new("XiMpLe.node",
+ name="author",
+ attributes=list(name=author.name, email=author.email, url=author.url))
+ return(result)
+ }))
+
+ ## package
+ # - name
+ # - min="min_version",
+ # - max="max_version",
+ # - repository
+ 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
+ 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
+ if(!is.null(xml.pluginmap)){
+ for (pmap in xml.pluginmap){
+ xml.package[[length(xml.package)+1]] <- pmap
+ }
+ } else {}
+ if(is.null(xml.package)){
+ xml.package <- list()
+ } 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=""
+ )
+ # skip dependency listing if it has no entries
+ if(all(sapply(xml.dependencies at attributes, is.null)) & length(xml.dependencies at children) == 0){
+ xml.dependencies <- NULL
+ } else {}
+
+ ## about
+ # - name
+ # - desc="shortinfo",
+ # - version
+ # - date="releasedate",
+ # - url
+ # - license
+ # - category
+ # + authors
+ # + dependencies
+ if(!is.null(xml.dependencies)){
+ xml.authors[[length(xml.authors)+1]] <- xml.dependencies
+ } else {}
+ if(is.null(xml.authors)){
+ xml.authors <- list()
+ } else {}
+ xml.about <- new("XiMpLe.node",
+ name="about",
+ attributes=list(
+ name=about[["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/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.cbox.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.cbox.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.cbox.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,28 @@
+#' Create XML node "checkbox" for RKWard plugins
+#'
+#' @param label Character string, a text label for this plugin element.
+#' @param val Character string, the value to submit if the element is checked.
+#' @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
+
+rk.XML.cbox <- function(label, val, chk=FALSE, id.name="auto"){
+ if(identical(id.name, "auto")){
+ id <- auto.ids(label, prefix="chk.")
+ } else {
+ id <- id.name
+ }
+
+ attr.list <- list(id=id, label=label, value=val)
+ if(isTRUE(chk)){
+ attr.list[["checked"]] <- "true"
+ } else {}
+
+ checkbox <- new("XiMpLe.node",
+ name="checkbox",
+ attributes=attr.list)
+
+ return(checkbox)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.col.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.col.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.col.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,23 @@
+#' 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
+
+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/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.dropdown.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.dropdown.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.dropdown.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,42 @@
+#' Create XML node "dropdown" for RKWard plugins
+#'
+#' @param label Character string, a text label for this plugin element.
+#' @param opts A named list with options to choose from. The names of the list elements will become
+#' labels of the options, \code{val} defines the value to submit if the option is checked, and
+#' \code{chk=TRUE} should be set in the one option which is checked by default.
+#' @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
+
+rk.XML.dropdown <- function(label, opts=list(label=c(val=NULL, chk=FALSE)), id.name="auto"){
+ num.opt <- length(opts)
+ dd.options <- sapply(1:num.opt, function(this.num){
+ this.element <- names(opts)[[this.num]]
+ this.value <- opts[[this.num]][["val"]]
+ attr.list <- list(label=this.element, value=this.value)
+ if("chk" %in% names(opts[[this.num]])){
+ if(isTRUE(as.logical(opts[[this.num]][["chk"]]))){
+ attr.list[["checked"]] <- "true"
+ } else {}
+ } else {}
+ new("XiMpLe.node",
+ name="option",
+ attributes=attr.list)
+ })
+
+ if(identical(id.name, "auto")){
+ id <- auto.ids(label, prefix="drp.")
+ } else {
+ id <- id.name
+ }
+ drp.attr.list <- list(id=id, label=label)
+
+ dropdown <- new("XiMpLe.node",
+ name="dropdown",
+ attributes=drp.attr.list,
+ children=dd.options
+ )
+
+ return(dropdown)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.frame.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.frame.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.frame.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,30 @@
+#' Create XML node "column" for RKWard plugins
+#'
+#' @param children An optional list with objects of class \code{XiMpLe.node}.
+#' @param label Character string, a text label for this plugin element.
+#' @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.
+#' If \code{NULL}, no ID will be given.
+#' @return An object of class \code{XiMpLe.node}.
+#' @export
+
+rk.XML.frame <- function(children=list(), label=NULL, id.name="auto"){
+ if(!is.null(label)){
+ attr.list <- list(label=label)
+ if(identical(id.name, "auto")){
+ attr.list[["id"]] <- list(id=auto.ids(label, prefix="frm."))
+ } else if(!is.null(id.name)){
+ attr.list[["id"]] <- id.name
+ } else {}
+ } else {
+ attr.list <- list()
+ }
+
+ frame <- new("XiMpLe.node",
+ name="frame",
+ attributes=attr.list,
+ children=child.list(children),
+ value="")
+
+ return(frame)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.plugin.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.plugin.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.plugin.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,90 @@
+#' Create XML document for RKWard plugins
+#'
+#' @param name Character string, the name of the plugin.
+#' @param label Character string, a text label for the plugin's top level, i.e. the window title of the dialog.
+#' @param children An optional list with objects of class \code{XiMpLe.node}. Will be included inside the top level node.
+#' @param help Logical, if \code{TRUE} an include tag for a help file named \emph{"<name>.rkh"} will be added to the header.
+#' @param logic Logical, if \code{TRUE} a logic section will be added to the document.
+#' This must be edited manually, it is therefore commented out.
+#' @param provides Character vector with at least one entry of \code{"dialog"} or \code{"wizard"}, defining what the document provides.
+#' @param pluginmap Character string, relative path to the pluginmap file, which will then be included in the head of this document.
+#' @return An object of class \code{XiMpLe.doc}.
+#' @export
+# pluginmap must be the relative path to the pluginmap file, which will then be included
+
+rk.XML.plugin <- function(name, label, children=list(), help=TRUE, logic=TRUE, provides=c("dialog"), pluginmap=NULL){
+ name.orig <- name
+ name <- gsub("[[:space:]]*[^[:alnum:]]*", "", name)
+ if(!identical(name.orig, name)){
+ message(paste("For filenames ", sQuote(name.orig), " was renamed to ", sQuote(name), ".", sep=""))
+ } else {}
+
+ all.children <- list(new("XiMpLe.node",
+ name="code",
+ attributes=list(file=paste(name, ".js", sep=""))
+ ))
+
+ if(isTRUE(help)){
+ all.children[[length(all.children)+1]] <- new("XiMpLe.node",
+ name="help",
+ attributes=list(file=paste(name, ".rkh", sep=""))
+ )
+ } else {}
+
+ if(!is.null(pluginmap)){
+ all.children[[length(all.children)+1]] <- new("XiMpLe.node",
+ name="include",
+ attributes=list(file=pluginmap)
+ )
+ } else {}
+
+ if(isTRUE(logic)){
+ all.children[[length(all.children)+1]] <- new("XiMpLe.node",
+ name="logic",
+ children=list(
+ new("XiMpLe.node",
+ # add these as comments because they need editing
+ name="!--",
+ value="<convert id=\"!edit!\", mode=\"!edit!\", sources=\"!edit!\", standard=\"!edit!\" />"),
+ new("XiMpLe.node",
+ name="!--",
+ value="<connect client=\"!edit!\", governor=\"!edit!\" />")
+ )
+ )
+ } else {}
+
+ if("dialog" %in% provides){
+ plugin.dialog <- new("XiMpLe.node",
+ name="dialog",
+ attributes=list(label=label),
+ value="")
+ if(length(children) > 0){
+ plugin.dialog at children <- child.list(children)
+ } else {}
+ all.children[[length(all.children)+1]] <- plugin.dialog
+ } else {}
+
+ if("wizard" %in% provides){
+ ## TODO: wizard code
+ plugin.wizard <- new("XiMpLe.node",
+ name="wizard",
+ attributes=list(label=label),
+ value="")
+ if(length(children) > 0){
+ plugin.wizard at children <- child.list(children)
+ } else {}
+ all.children[[length(all.children)+1]] <- plugin.wizard
+ }
+
+ top.doc <- new("XiMpLe.node",
+ name="document",
+ children=child.list(all.children)
+ )
+
+ plugin <- new("XiMpLe.doc",
+ dtd=list(doctype="rkplugin"),
+ children=child.list(top.doc)
+ )
+
+ return(plugin)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.pluginmap.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.pluginmap.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.pluginmap.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,100 @@
+#' Write a pluginmap file for RKWard
+#'
+#' @param name Character string, name of the plugin.
+#' @param about A list with descriptive information on the plugin,its authors and dependencies.
+#' See \code{link[XiMpLe:rk.XML.about]{rk.XML.about}} for details!
+#' @param components A character vector with at least one plugin component file name,
+#' ending with ".xml".
+#' @param plugin.dir Character string, relative path to the component XML and JS files.
+#' @param hierarchy A character vector with instructions where to place the plugin in the menu hierarchy,
+#' one string for each included component. Valid values are \code{"analysis"}, \code{"plots"} and
+#' \code{"data"}. To place your dialogs somewhere else, edit the pluginmap manually.
+#' @export
+
+rk.XML.pluginmap <- function(name, about, components, plugin.dir="plugins", hierarchy="analysis"){
+ # to besure, remove all non-character symbols from name
+ name.orig <- name
+ name <- gsub("[[:space:]]*[^[:alnum:]]*", "", name)
+ if(!identical(name.orig, name)){
+ message(paste("For filenames ", sQuote(name.orig), " was renamed to ", sQuote(name), ".", sep=""))
+ } else {}
+
+ # .pluginmap has three children in <document>:
+ # - about
+ # - components
+ # - hierarchy
+ about.XML <- rk.XML.about(
+ about=about[["about"]],
+ author=about[["author"]],
+ dependencies=about[["dependencies"]],
+ package=about[["package"]],
+ pluginmap=about[["pluginmap"]])
+
+ components.XML <- new("XiMpLe.node",
+ name="components",
+ children=sapply(components, function(this.comp){
+ new("XiMpLe.node",
+ name="component",
+ attributes=list(
+ type="standard",
+ id=paste(name, ".", gsub(".xml", "", this.comp), sep=""),
+ file=paste(plugin.dir, "/", this.comp, sep=""),
+ label=gsub(".xml", "", this.comp))
+ )})
+ )
+
+ hier.comp.XML <- unlist(sapply(1:length(hierarchy), function(this.dial){
+ this.comp <- components[this.dial]
+ this.hier <- hierarchy[this.dial]
+ entry.XML <- new("XiMpLe.node",
+ name="menu",
+ attributes=list(
+ id=paste("menu_", name, ".", gsub(".xml", "", this.comp), sep=""),
+ label=name.orig),
+ children=list(new("XiMpLe.node",
+ name="entry",
+ attributes=list(
+ component=paste(name, ".", gsub(".xml", "", this.comp), sep=""))
+ )))
+
+ if(identical(this.hier, "plots")){
+ hier.XML <- new("XiMpLe.node",
+ name="menu",
+ attributes=list(
+ id="plots",
+ label="Plots"),
+ children=child.list(entry.XML))
+ } else if(identical(this.hier, "data")){
+ hier.XML <- new("XiMpLe.node",
+ name="menu",
+ attributes=list(
+ id="data",
+ label="Data"),
+ children=child.list(entry.XML))
+ } else {
+ hier.XML <- new("XiMpLe.node",
+ name="menu",
+ attributes=list(
+ id="analysis",
+ label="Analysis"),
+ children=child.list(entry.XML))
+ }
+ }))
+
+ hierarchy.XML <- new("XiMpLe.node",
+ name="hierarchy",
+ children=hier.comp.XML)
+
+ top.doc <- new("XiMpLe.node",
+ name="document",
+ attributes=list(base_prefix="", namespace="rkward", id=paste(name, "_rkward", sep="")),
+ children=list(about.XML, components.XML, hierarchy.XML)
+ )
+
+ pluginmap <- new("XiMpLe.doc",
+ dtd=list(doctype="rkpluginmap"),
+ children=child.list(top.doc)
+ )
+
+ return(pluginmap)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.radio.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.radio.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.radio.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,42 @@
+#' Create XML node "radio" for RKWard plugins
+#'
+#' @param label Character string, a text label for this plugin element.
+#' @param opts A named list with options to choose from. The names of the list elements will become
+#' labels of the options, \code{val} defines the value to submit if the option is checked, and
+#' \code{chk=TRUE} should be set in the one option which is checked by default.
+#' @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
+
+rk.XML.radio <- function(label, opts=list(label=c(val=NULL, chk=FALSE)), id.name="auto"){
+ num.opt <- length(opts)
+ rd.options <- sapply(1:num.opt, function(this.num){
+ this.element <- names(opts)[[this.num]]
+ this.value <- opts[[this.num]][["val"]]
+ attr.list <- list(label=this.element, value=this.value)
+ if("chk" %in% names(opts[[this.num]])){
+ if(isTRUE(as.logical(opts[[this.num]][["chk"]]))){
+ attr.list[["checked"]] <- "true"
+ } else {}
+ } else {}
+ new("XiMpLe.node",
+ name="option",
+ attributes=attr.list)
+ })
+
+ if(identical(id.name, "auto")){
+ id <- auto.ids(label, prefix="rad.")
+ } else {
+ id <- id.name
+ }
+ rd.attr.list <- list(id=id, label=label)
+
+ radio <- new("XiMpLe.node",
+ name="radio",
+ attributes=rd.attr.list,
+ children=child.list(rd.options)
+ )
+
+ return(radio)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.row.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.row.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.row.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,23 @@
+#' Create XML node "row" 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
+
+rk.XML.row <- function(children=list(), id.name=NULL){
+ if(!is.null(id.name)){
+ attr.list <- list(id=id.name)
+ } else {
+ attr.list <- list()
+ }
+
+ row <- new("XiMpLe.node",
+ name="row",
+ attributes=attr.list,
+ children=child.list(children),
+ value="")
+
+ return(row)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.tabbook.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.tabbook.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.tabbook.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,62 @@
+#' Create XML node "tabbook" for RKWard plugins
+#'
+#' @param label Character string, a text label for this plugin element.
+#' @param tab.labels Character vector, where each string defines the name of one tab.
+#' The number of \code{tab.labels} also defines the number of tabs.
+#' @param children An optional list with objects of class \code{XiMpLe.node} (or a list of these objects).
+#' You must provide one element for each tab. Use \code{NULL} for tabs without predefined children.
+#' @param id.name Character vector, unique IDs for the tabbook (first entry) and all tabs.
+#' If \code{"auto"}, IDs will be generated automatically from the labels.
+#' If \code{NULL}, no IDs will be given.
+#' @return An object of class \code{XiMpLe.node}.
+#' @export
+
+rk.XML.tabbook <- function(label, tab.labels, children=list(), id.name="auto"){
+ num.tabs <- length(tab.labels)
+ # check if number of children fits
+ if(length(children) > 0){
+ if(!identical(length(children), num.tabs)){
+ stop(simpleError("If you provide children, you must do so for each tab (use NULL for tabs without children)!"))
+ } else {}
+ } else {
+ children <- NULL
+ }
+
+ if(identical(id.name, "auto")){
+ tab.ids <- auto.ids(tab.labels, prefix="tab.")
+ } else {}
+ tabs <- sapply(1:num.tabs, function(this.num){
+ this.tab <- tab.labels[[this.num]]
+ attr.list <- list(label=this.tab)
+ if(identical(id.name, "auto")){
+ attr.list[["id"]] <- tab.ids[[this.num]]
+ } else if(!is.null(id.name)){
+ attr.list[["id"]] <- id.name[[this.num + 1]]
+ } else {}
+ if(!is.null(children[[this.num]])){
+ child <- children[[this.num]]
+ } else {
+ child <- list()
+ }
+ new("XiMpLe.node",
+ name="tab",
+ attributes=attr.list,
+ children=child.list(child),
+ value="")
+ })
+
+ if(identical(id.name, "auto")){
+ tb.id <- auto.ids(label, prefix="tbk.")
+ } else if(!is.null(id.name)){
+ tb.id <- id.name[[1]]
+ } else {}
+ tbk.attr.list <- list(id=tb.id, label=label)
+
+ tabbook <- new("XiMpLe.node",
+ name="tabbook",
+ attributes=tbk.attr.list,
+ children=child.list(tabs)
+ )
+
+ return(tabbook)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.vars.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.vars.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.XML.vars.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,53 @@
+#' Create a variable selector for RKWard plugins
+#'
+#' This function will create a <frame> node including a <varselector> and a <varslot> node.
+#'
+#' @param label Character string, a text label for the whole frame.
+#' @param slot.text Character string, a text label for the variable selection slot.
+#' @param classes An optional character vector, defining class names to which the selection must be limited.
+#' @param horiz Logical. If \code{TRUE}, the varslot will be placed next to the selector,
+#' if \code{FALSE} below it.
+#' @param id.name Character vector, unique IDs for the frame (first entry), the varselector (second entry)
+#' and varslot (third entry).
+#' If \code{"auto"}, IDs will be generated automatically from \code{label} and \code{slot.text}.
+#' @return An object of class \code{XiMpLe.node}.
+#' @export
+
+rk.XML.vars <- function(label, slot.text=NULL, classes=NULL, horiz=TRUE, id.name="auto"){
+ if(identical(id.name, "auto")){
+ var.sel.attr <- list(id=auto.ids(label, prefix="var."))
+ var.slot.attr <- list(id=auto.ids(label, prefix="vars."))
+ } else if(!is.null(id.name)){
+ var.sel.attr <- list(id=id.name[[2]])
+ var.slot.attr <- list(id=id.name[[3]])
+ } else {}
+
+ v.selector <- new("XiMpLe.node",
+ name="varselector",
+ attributes=var.sel.attr)
+
+ if(!is.null(slot.text)){
+ var.slot.attr[["label"]] <- slot.text
+ } else {}
+
+ var.slot.attr[["sources"]] <- var.sel.attr[["id"]]
+ if(!is.null(classes)){
+ var.slot.attr[["classes"]] <- paste(classes, collapse=" ")
+ } else {}
+
+ v.slot <- new("XiMpLe.node",
+ name="varslot",
+ attributes=var.slot.attr)
+
+ if(isTRUE(horiz)){
+ aligned.chld <- rk.XML.row(list(rk.XML.col(v.selector), rk.XML.col(v.slot)))
+ } else {
+ aligned.chld <- list(v.selector, v.slot)
+ }
+ vars.frame <- rk.XML.frame(
+ children=child.list(aligned.chld),
+ label=label,
+ id.name=id.name[[1]])
+
+ return(vars.frame)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.plugin.skeleton.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.plugin.skeleton.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.plugin.skeleton.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,167 @@
+#' Create skeleton for RKWard plugins
+#'
+#' @param name Character sting, name of the plugin package.
+#' @param path Character sting, path to the main directory where the skeleton should be created.
+#' @param about A list with descriptive information on the plugin,its authors and dependencies.
+#' See \code{\link[XiMpLe:rk.XML.about]{rk.XML.about}} for details!
+#' @param dialog A list of objects of class XiMpLe.node. If provided, will be included in the
+#' created plugin XML file as the dialog.
+#' @param dial.require A character vector with names of R packages that the dialog requires.
+#' @param overwrite Logical, whether existing files should be replaced. Defaults to \code{FALSE}.
+#' @export
+#' @examples
+#' \dontrun{
+#' about.info <- list(
+#' about=list(
+#' name="Square the circle",
+#' 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"),
+#' author=list(
+#' c(name="E.A. Dölle", email="doelle@@eternalwondermaths.example.org",
+#' url="http://eternalwondermaths.example.org"),
+#' c(name="A. Assistant", email="alterego@@eternalwondermaths.example.org",
+#' url="http://eternalwondermaths.example.org/staff/")
+#' ),
+#' 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"))
+#' )
+#'
+#' rk.plugin.skeleton("Square the Circle", path="/tmp", about=about.info)
+#'
+#' # a more complex example, already including some dialog elements
+#' test.dropdown <- rk.XML.dropdown("mydrop",
+#' opts=list("First Option"=c(val="val1"),
+#' "Second Option"=c(val="val2", chk=TRUE)))
+#' test.checkboxes <- rk.XML.row(rk.XML.col(
+#' list(test.dropdown,
+#' rk.XML.cbox(label="foo", val="foo1", chk=TRUE),
+#' rk.XML.cbox(label="bar", val="bar2"))
+#' ))
+#' test.vars <- rk.XML.vars("select some vars", "vars go here")
+#' test.tabbook <- rk.XML.tabbook("My Tabbook", tab.labels=c("First Tab",
+#' "Second Tab"), children=list(test.checkboxes, test.vars))
+#' test.plugin <- rk.XML.plugin("My test", label="Check this out",
+#' children=test.tabbook)
+#'
+#' rk.plugin.skeleton("Square the Circle", path="/tmp",
+#' about=about.info, dialog=test.tabbook, overwrite=TRUE)
+#' }
+
+rk.plugin.skeleton <- function(name, path, about, dialog=list(), dial.require=c(), overwrite=FALSE){
+ # to besure, remove all non-character symbols from name
+ name.orig <- name
+ name <- gsub("[[:space:]]*[^[:alnum:]]*", "", name)
+ if(!identical(name.orig, name)){
+ message(paste("For filenames ", sQuote(name.orig), " was renamed to ", sQuote(name), ".", sep=""))
+ } else {}
+ # define paths an file names
+ main.dir <- file.path(path, name)
+ description.file <- file.path(main.dir, "DESCRIPTION")
+ rkward.dir <- file.path(main.dir, "inst", "rkward")
+ plugin.dir <- file.path(rkward.dir, "plugins")
+ plugin.pluginmap <- file.path(rkward.dir, paste(name, ".pluginmap", sep=""))
+ plugin.xml <- file.path(plugin.dir, paste(name, ".xml", sep=""))
+ plugin.js <- file.path(plugin.dir, paste(name, ".js", sep=""))
+ plugin.rkh <- file.path(plugin.dir, paste(name, ".rkh", sep=""))
+
+ checkCreateFiles <- function(file.name, ow=overwrite){
+ if(all(file.exists(file.name), as.logical(ow)) | !file.exists(file.name)){
+ return(TRUE)
+ } else {
+ warning(paste("Skipping existing file ", file.name, ".", sep=""))
+ return(FALSE)
+ }
+ }
+
+ # check if we can access the given root directory
+ # create it, if necessary
+ if(!file_test("-d", main.dir)){
+ stopifnot(dir.create(main.dir, recursive=TRUE))
+ message(paste("Created directory ", main.dir, ".", sep=""))
+ } else {}
+
+ # create directory structure
+ if(!file_test("-d", plugin.dir)){
+ stopifnot(dir.create(plugin.dir, recursive=TRUE))
+ message(paste("Created directory ", plugin.dir, ".", sep=""))
+ } else {}
+
+ ## create plugin.xml
+ if(isTRUE(checkCreateFiles(plugin.xml))){
+ XML.plugin <- rk.XML.plugin(
+ name=name,
+ label=name.orig,
+ children=dialog,
+ pluginmap=paste("../", name, ".pluginmap", sep=""))
+ cat(pasteXMLTree(XML.plugin, shine=1), file=plugin.xml)
+ } else {}
+
+ ## create plugin.js
+ if(isTRUE(checkCreateFiles(plugin.js))){
+ JS.code <- rk.JS.doc(
+ require=dial.require,
+ variables=rk.JS.scan(XML.plugin),
+ results.header=paste(name.orig, " results", sep=""))
+ cat(JS.code, file=plugin.js)
+ } else {}
+
+ ## create plugin.rkh
+ if(isTRUE(checkCreateFiles(plugin.rkh))){
+ rkh.doc <- rk.rkh.doc(settings=rk.rkh.scan(XML.plugin))
+ cat(pasteXMLTree(rkh.doc, shine=1), file=plugin.rkh)
+ } else {}
+
+ ## create plugin.pluginmap
+ if(isTRUE(checkCreateFiles(plugin.pluginmap))){
+ XML.pluginmap <- rk.XML.pluginmap(
+ name=name,
+ about=about,
+ components=paste(name, ".xml", sep=""),
+ plugin.dir="plugins",
+ hierarchy="analysis")
+ cat(pasteXMLTree(XML.pluginmap), file=plugin.pluginmap)
+ } else {}
+
+ # create DESCRIPTION file
+ if(isTRUE(checkCreateFiles(description.file))){
+ all.authors <- paste(
+ sapply(about.info[["author"]], function(this.author){
+ paste(this.author[["name"]], " <", this.author[["email"]], ">", sep="")
+ }),
+ collapse=", ")
+## TODO: check and add the commented values here:
+ desc <- data.frame(
+ Package=name,
+ Type="Package",
+ Title=about[["about"]][["name"]],
+ Version=about[["about"]][["version"]],
+ Date=about[["about"]][["date"]],
+ Author=all.authors,
+# AuthorR="c(person(given=\"X\", family=\"YZ\", email=\"some at example.de\"))",
+ Maintainer=all.authors,
+# Depends="R (>= 2.9.0)",
+ Enhances="rkward",
+ Description=about[["about"]][["desc"]],
+ License=about[["about"]][["license"]],
+# Encoding="UTF-8",
+# LazyLoad="yes",
+ URL=about[["about"]][["url"]],
+ stringsAsFactors=FALSE)
+ write.dcf(desc, file=description.file)
+ } else {}
+
+ return(invisible(NULL))
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.rkh.doc.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.rkh.doc.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.rkh.doc.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,117 @@
+#' Create RKWard help file skeleton
+#'
+#' Create RKWard help file skeleton
+#'
+#' @param summary A list of objects of class \code{XiMpLe.node} or a character string with the content of the Summary section.
+#' @param usage A list of objects of class \code{XiMpLe.node} or a character string with the content of the Usage section.
+#' @param settings A list of objects of class \code{XiMpLe.node} with the content of the Settings section.
+#' Refer to \code{\link{rk.rkh.scan}} for a function to create this from an existing plugin XML file.
+#' @param related A list of objects of class \code{XiMpLe.node} or a character string with the content of the Related section.
+#' @param technical A list of objects of class \code{XiMpLe.node} or a character string with the content of the technical section.
+#' @return An object of class \code{XiMpLe.doc}.
+#' @export
+
+rk.rkh.doc <- function(summary=NULL, usage=NULL, settings=NULL, related=NULL, technical=NULL){
+
+ rkh.summary <- new("XiMpLe.node",
+ name="summary")
+ if(is.null(summary)){
+ rkh.summary at value <- ""
+ } else if(is.list(summary)){
+ rkh.summary at children <- summary
+ } else if(inherits(summary, "XiMpLe.node")){
+ rkh.summary at children <- list(summary)
+ } else {
+ rkh.summary at value <- summary
+ }
+
+ rkh.usage <- new("XiMpLe.node",
+ name="usage")
+ if(is.null(usage)){
+ rkh.usage at value <- ""
+ } else if(is.list(usage)){
+ rkh.usage at children <- usage
+ } else if(inherits(usage, "XiMpLe.node")){
+ rkh.usage at children <- list(usage)
+ } else {
+ rkh.usage at value <- usage
+ }
+
+ rkh.settings <- new("XiMpLe.node",
+ name="settings")
+ if(is.null(settings)){
+ rkh.settings at value <- ""
+ } else if(is.list(settings)){
+ rkh.settings at children <- settings
+ } else if(inherits(settings, "XiMpLe.node")){
+ rkh.settings at children <- list(settings)
+ } else {
+ rkh.settings at value <- settings
+ }
+
+ rkh.related <- new("XiMpLe.node",
+ name="related")
+ if(is.null(related)){
+ rkh.related at children <- list(new("XiMpLe.node",
+ name="!--",
+ value="<ul><li><link href=\"rkward://rhelp/...\"/></li></ul>"))
+ } else if(is.list(related)){
+ rkh.related at children <- related
+ } else if(inherits(related, "XiMpLe.node")){
+ rkh.related at children <- list(related)
+ } else {
+ rkh.related at value <- related
+ }
+
+ rkh.technical <- new("XiMpLe.node",
+ name="technical")
+ if(is.null(technical)){
+ rkh.technical at value <- ""
+ } else if(is.list(technical)){
+ rkh.technical at children <- technical
+ } else if(inherits(technical, "XiMpLe.node")){
+ rkh.technical at children <- list(technical)
+ } else {
+ rkh.technical at value <- technical
+ }
+
+ rkh.document <- new("XiMpLe.node",
+ name="document",
+ children=list(rkh.summary, rkh.usage, rkh.settings, rkh.related, rkh.technical),
+ value="")
+
+ rkh.main <- new("XiMpLe.doc",
+ dtd=list(doctype="rkhelp"),
+ children=list(rkh.document))
+
+ return(rkh.main)
+}
+
+# <!DOCTYPE rkhelp>
+# <document>
+# <summary>
+# </summary>
+#
+# <usage>
+# </usage>
+#
+# <settings>
+# <caption id="tab_klausur"/>
+# <setting id="antworten">
+# </setting>
+# <setting id="richtig" title="Correct answers">
+# </setting>
+# </settings>
+#
+# <related>
+# Please refer to the <code>klausuR</code> manuals for further information and detailed command line options:
+# <ul>
+# <li><link href="rkward://rhelp/klausuR-package"/></li>
+# <li><link href="rkward://rhelp/klausur"/></li>
+# <li><link href="rkward://rhelp/klausur.report"/></li>
+# </ul>
+# </related>
+#
+# <technical>
+# </technical>
+# </document>
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.rkh.scan.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.rkh.scan.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rk.rkh.scan.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,35 @@
+#' Create RKWard help nodes 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 help Logical, if \code{TRUE} a list of XiMpLe.node objects will be returned, otherwise a character
+#' vector with only the relevant ID names.
+#' @return A character vector or a list of XiMpLe.node objects.
+#' @export
+
+rk.rkh.scan <- function(pXML, help=TRUE){
+
+ help.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"))
+
+ help.id <- get.IDs(single.tags=single.tags, relevant.tags=help.relevant.tags, add.abbrev=FALSE)
+
+ if("id" %in% colnames(help.id)){
+ if(isTRUE(help)){
+ help.nodes <- unlist(sapply(1:nrow(help.id), function(this.id){
+ rkh.setting.node <- new("XiMpLe.node",
+ name="setting",
+ attributes=list(id=help.id[this.id,"id"]),
+ value="")
+ return(rkh.setting.node)
+ }))
+ } else {
+ help.nodes <- help.id[,"id"]
+ }
+ } else {
+ help.nodes <- NULL
+ }
+
+ return(help.nodes)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rkwarddev-desc-internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rkwarddev-desc-internal.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rkwarddev-desc-internal.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,16 @@
+# package description files
+pckg.dscrptn <- data.frame(
+ Package="rkwarddev",
+ Type="Package",
+ Title="A collection of tools for RKWard plugin development",
+ Author="m.eik michalke <meik.michalke at hhu.de>",
+ AuthorR="c(person(given=\"Meik\", family=\"Michalke\", email=\"meik.michalke at hhu.de\"))",
+ Maintainer="m.eik michalke <meik.michalke at hhu.de>",
+ Depends="R (>= 2.9.0), XiMpLe",
+ 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",
+ stringsAsFactors=FALSE)
Added: trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rkwarddev-package.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rkwarddev-package.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwarddev/R/rkwarddev-package.R 2011-09-05 11:34:51 UTC (rev 3726)
@@ -0,0 +1,25 @@
+#' A collection of tools for RKWard plugin development.
+#'
+#' \tabular{ll}{
+#' Package: \tab rkwarddev\cr
+#' Type: \tab Package\cr
+#' Version: \tab 0.01-1\cr
+#' Date: \tab 2011-09-05\cr
+#' Depends: \tab R (>= 2.9.0), XiMpLe\cr
+#' Enhances: \tab rkward\cr
@@ 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