[rkward-cvs] SF.net SVN: rkward:[3876] trunk/rkward/packages/rkwarddev/R

[m-eik at users.sourceforge.net]

Revision: 3876
          http://rkward.svn.sourceforge.net/rkward/?rev=3876&view=rev
Author:   m-eik
Date:     2011-10-03 16:47:37 +0000 (Mon, 03 Oct 2011)
Log Message:
-----------
rkwarddev: rk.JS.array() now takes XML node objects, too

Modified Paths:
--------------
    trunk/rkward/packages/rkwarddev/R/rk-internal.R
    trunk/rkward/packages/rkwarddev/R/rk.JS.array.R
    trunk/rkward/packages/rkwarddev/R/rk.paste.JS.R

Modified: trunk/rkward/packages/rkwarddev/R/rk-internal.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk-internal.R	2011-10-02 22:11:13 UTC (rev 3875)
+++ trunk/rkward/packages/rkwarddev/R/rk-internal.R	2011-10-03 16:47:37 UTC (rev 3876)
@@ -52,15 +52,35 @@
 
 ## 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' can also contain XiMpLe.node objects
+get.IDs <- function(single.tags, relevant.tags, add.abbrev=FALSE){
 
-	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)]
+	# filter for relevant tags
+	cleaned.tags <- list()
+	for(this.tag in child.list(single.tags)){
+		if(inherits(this.tag, "XiMpLe.node")){
+			this.tag.name <- this.tag at name
+			if(this.tag.name %in% relevant.tags & "id" %in% names(this.tag at attributes)){
+				cleaned.tags[length(cleaned.tags)+1] <- this.tag
+			} else {}
+		} else {
+			this.tag.name <- tolower(XiMpLe:::XML.tagName(this.tag))
+			# we're only interested in entries with an ID
+			if(this.tag.name %in% relevant.tags & grepl("[[:space:]]+id=", this.tag)){
+				cleaned.tags[length(cleaned.tags)+1] <- this.tag
+			} else {}
+		}
+	}
 
-	ids <- t(sapply(single.tags, function(this.tag){
-			this.tag.name <- XiMpLe:::XML.tagName(this.tag)
-			this.tag.id <- XiMpLe:::parseXMLAttr(this.tag)[["id"]]
+	ids <- t(sapply(cleaned.tags, function(this.tag){
+				if(inherits(this.tag, "XiMpLe.node")){
+					this.tag.name <- this.tag at name
+					this.tag.id <- this.tag at attributes["id"]
+				} else {
+					this.tag.name <- XiMpLe:::XML.tagName(this.tag)
+					this.tag.id <- XiMpLe:::parseXMLAttr(this.tag)[["id"]]
+				}
+
 				if(isTRUE(add.abbrev)){
 					this.tag.id.abbrev <- paste(ID.prefix(this.tag.name), this.tag.id, sep="")
 				} else {
@@ -108,6 +128,11 @@
 # in XML will become
 #   var my.id = getValue("my.id");
 get.JS.vars <- function(JS.var, XML.var=NULL, JS.prefix="", indent.by="", names.only=FALSE){
+	# check for XiMpLe nodes
+	JS.var <- check.ID(JS.var)
+	if(!is.null(XML.var)){
+		XML.var <- check.ID(XML.var)
+	} else {}
 	if(isTRUE(names.only)){
 		results <- camelCode(c(JS.prefix, JS.var))
 	} else {

Modified: trunk/rkward/packages/rkwarddev/R/rk.JS.array.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.JS.array.R	2011-10-02 22:11:13 UTC (rev 3875)
+++ trunk/rkward/packages/rkwarddev/R/rk.JS.array.R	2011-10-03 16:47:37 UTC (rev 3876)
@@ -18,12 +18,12 @@
 #' @examples
 #' cat(rk.JS.array("my.option", variables=c("frst.var", "scnd.var")))
 
-rk.JS.array <- function(option, variables=NULL, list=FALSE, def.vars=TRUE, var.prefix="chc", indent.by="\t"){
+rk.JS.array <- function(option, variables=NULL, list=FALSE, def.vars=FALSE, var.prefix=NULL, indent.by="\t"){
 	arr.name <- camelCode(c("arr", option))
 	opt.name <- camelCode(c("opt", option))
 
 	if(isTRUE(def.vars)){
-		JS.vars <- paste(unlist(sapply(variables, function(this.var){get.JS.vars(
+		JS.vars <- paste(unlist(sapply(child.list(variables), function(this.var){get.JS.vars(
 							JS.var=this.var,
 							XML.var=this.var,
 							JS.prefix=var.prefix,
@@ -36,7 +36,7 @@
 	JS.array <- paste(
 		indent(2, by=indent.by), "var ", arr.name, " = new Array();\n",
 		indent(2, by=indent.by), arr.name, ".push(",
-		paste(unlist(sapply(variables, function(this.var){get.JS.vars(
+		paste(unlist(sapply(child.list(variables), function(this.var){get.JS.vars(
 							JS.var=this.var,
 							JS.prefix=var.prefix,
 							names.only=TRUE)

Modified: trunk/rkward/packages/rkwarddev/R/rk.paste.JS.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.paste.JS.R	2011-10-02 22:11:13 UTC (rev 3875)
+++ trunk/rkward/packages/rkwarddev/R/rk.paste.JS.R	2011-10-03 16:47:37 UTC (rev 3876)
@@ -10,8 +10,8 @@
 rk.paste.JS <- function(object, level=1, indent.by="\t"){
 	stopifnot(level > 0)
 	# check indentation
-	main.indent <- paste(rep(indent.by, level-1), collapse="")
-	scnd.indent <- paste(rep(indent.by, level), collapse="")
+	main.indent <- indent(level, by=indent.by)
+	scnd.indent <- indent(level+1, by=indent.by)
 
 	if(inherits(object, "rk.JS.ite")){
 		ifJS <- paste(main.indent, "if(", object at ifJS, ") {\n", sep="")

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.