[rkward-cvs] SF.net SVN: rkward-code:[4543] trunk/rkward/packages/rkwarddev

m-eik at users.sf.net m-eik at users.sf.net
Wed Feb 20 16:39:58 UTC 2013


Revision: 4543
          http://sourceforge.net/p/rkward/code/4543
Author:   m-eik
Date:     2013-02-20 16:39:50 +0000 (Wed, 20 Feb 2013)
Log Message:
-----------
rkwarddev: rk.JS.scan now knows about <optionset>, <matrix> needs testing; guess.getter seems to work, too

Modified Paths:
--------------
    trunk/rkward/packages/rkwarddev/ChangeLog
    trunk/rkward/packages/rkwarddev/R/rk-internal.R
    trunk/rkward/packages/rkwarddev/R/rk.JS.scan.R

Modified: trunk/rkward/packages/rkwarddev/ChangeLog
===================================================================
--- trunk/rkward/packages/rkwarddev/ChangeLog	2013-02-20 14:19:23 UTC (rev 4542)
+++ trunk/rkward/packages/rkwarddev/ChangeLog	2013-02-20 16:39:50 UTC (rev 4543)
@@ -1,6 +1,6 @@
 ChangeLog for package rkwarddev
 
-changes in version 0.06-2 (2013-02-18)
+changes in version 0.06-2 (2013-02-20)
 changed:
   - the structure of <about> nodes will change in RKWard 0.6.1, <dependencies> will become
     a direct child of <document> or <component>, which explains several changes in this release.
@@ -14,6 +14,7 @@
     releases. consequently, rk.JS.vars() and rk.paste.JS() have a new "getter" argument to set
     or overwrite this value. another new argument, "guess.getter", can be used to turn on
     automatic guessing which getter function might be most appropriate.
+  - rk.JS.scan() learned how to treat <optionset> and <matrix>
 added:
   - new function rk.XML.switch()
   - new function rk.XML.optiondisplay()

Modified: trunk/rkward/packages/rkwarddev/R/rk-internal.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk-internal.R	2013-02-20 14:19:23 UTC (rev 4542)
+++ trunk/rkward/packages/rkwarddev/R/rk-internal.R	2013-02-20 16:39:50 UTC (rev 4543)
@@ -185,6 +185,39 @@
 	return(ids)
 } ## end function get.IDs()
 
+## function check.optionset.tags
+# XML.obj may be a character string (file name) or XiMpLe object
+# this functions will check if <optionset> nodes are present
+# and return a possibly corrected result of get.single.tags()
+check.optionset.tags <- function(XML.obj, drop=NULL){
+	# if this is not a XiMpLe object, transform the file into one
+	if(!is.XiMpLe.node(XML.obj) && !is.XiMpLe.doc(XML.obj)){
+		XML.obj <- parseXMLTree(XML.obj, drop=drop)
+	} else {}
+	# first get a list of all optionsets
+	optionset.nodes <- child.list(XMLScan(XML.obj, "optionset"))
+	# are there any?
+	if(is.null(optionset.nodes)){
+		result <- get.single.tags(XML.obj=XML.obj, drop=drop)
+	} else {
+		# now go through all sets and combine setID with the IDs of optioncolumns
+		optioncolumnNewIDs <- unlist(sapply(optionset.nodes, function(thisNode){
+				thisCols <- child.list(XMLScan(thisNode, "optioncolumn"))
+				thisSetID <- XMLAttrs(thisNode)[["id"]]
+				thisNewCols <- unlist(sapply(thisCols, function(thisCol){
+						thisColsID <- XMLAttrs(thisCol)[["id"]]
+						XMLAttrs(thisCol)[["id"]] <- paste(thisSetID, thisColsID, sep=".")
+						pastedTag <- get.single.tags(XML.obj=thisCol, drop=drop)
+						return(pastedTag)
+					}, USE.NAMES=FALSE))
+				return(thisNewCols)
+			}, USE.NAMES=FALSE))
+		# we don't need the set nodes any longer
+		XMLScan(XML.obj, "optionset") <- NULL
+		result <- c(optioncolumnNewIDs, get.single.tags(XML.obj=XML.obj, drop=drop))
+	}
+	return(result)
+} ## end function check.optionset.tags
 
 ## function camelCode()
 # changes the first letter of each string
@@ -229,7 +262,7 @@
 #   <tag id="my.id" ...>
 # in XML will become
 #   var my.id = getValue("my.id");
-get.JS.vars <- function(JS.var, XML.var=NULL, JS.prefix="", names.only=FALSE, modifiers=NULL, default=FALSE, join="",
+get.JS.vars <- function(JS.var, XML.var=NULL, tag.name=NULL, JS.prefix="", names.only=FALSE, modifiers=NULL, default=FALSE, join="",
 	getter="getValue", guess.getter=FALSE, check.modifiers=TRUE){
 	# check for XiMpLe nodes
 	JS.var <- check.ID(JS.var)
@@ -259,8 +292,13 @@
 			}
 		} else {}
 		# check for getter guessing
-		if(isTRUE(guess.getter) && is.XiMpLe.node(XML.var)){
-			tag.name <- XMLName(XML.var)
+		if(isTRUE(guess.getter)){
+			if(is.XiMpLe.node(XML.var)){
+				tag.name <- XMLName(XML.var)
+			} else if(is.null(tag.name)){
+				# hm, not a XiMpLe object and no known tag name :-/
+				tag.name <- XMLName(XMLChildren(parseXMLTree(XML.var, object=TRUE))[[1]])
+			} else {}
 			if(tag.name %in% names(JS.getters.default)){
 				getter <- JS.getters.default[[tag.name]]
 			} else {}

Modified: trunk/rkward/packages/rkwarddev/R/rk.JS.scan.R
===================================================================
--- trunk/rkward/packages/rkwarddev/R/rk.JS.scan.R	2013-02-20 14:19:23 UTC (rev 4542)
+++ trunk/rkward/packages/rkwarddev/R/rk.JS.scan.R	2013-02-20 16:39:50 UTC (rev 4543)
@@ -16,11 +16,13 @@
 rk.JS.scan <- function(pXML, js=TRUE, add.abbrev=FALSE, guess.getter=FALSE, indent.by="\t"){
 
 	JS.relevant.tags <- c("radio", "varslot", "browser", "dropdown",
-		"checkbox", "saveobject", "input", "spinbox")
+		"checkbox", "saveobject", "input", "spinbox", "optioncolumn", "matrix")
 	
-	single.tags <- get.single.tags(XML.obj=pXML, drop=c("comments","cdata", "declarations", "doctype"))
+	# getting the relevant IDs out of optionsets is a little tricky
+	# this function will probe for sets and return single tags
+	single.tags <- check.optionset.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)
+	JS.id <- get.IDs(single.tags=single.tags, relevant.tags=JS.relevant.tags, add.abbrev=add.abbrev, tag.names=TRUE)
 
 	if("id" %in% colnames(JS.id)){
 		if(isTRUE(js)){
@@ -32,9 +34,10 @@
 					return(rk.paste.JS(get.JS.vars(
 						JS.var=JS.id[this.id,"abbrev"],
 						XML.var=JS.id[this.id,"id"],
+						tag.name=JS.id[this.id,"tag"],
 						guess.getter=guess.getter),
 						level=2, indent.by=indent.by))
-				})), collapse="\n")
+				}, USE.NAMES=FALSE)), collapse="\n")
 		} else {
 			JS.lines <- JS.id[,"id"]
 			names(JS.lines) <- NULL
@@ -45,17 +48,19 @@
 
 	# special tags: must be checkable and get "checked" property
 	JS.special.tags <- c("frame")
-	JS.special.id <- get.IDs(single.tags=single.tags, relevant.tags=JS.special.tags, add.abbrev=add.abbrev, only.checkable=TRUE)
+	JS.special.id <- get.IDs(single.tags=single.tags, relevant.tags=JS.special.tags, add.abbrev=add.abbrev,
+		tag.names=TRUE, only.checkable=TRUE)
 	if("id" %in% colnames(JS.special.id)){
 		if(isTRUE(js)){
 			JS.lines <- paste(JS.lines, "\n", paste(unlist(sapply(1:nrow(JS.special.id), function(this.id){
 					return(rk.paste.JS(get.JS.vars(
 						JS.var=JS.special.id[this.id,"abbrev"],
 						XML.var=JS.special.id[this.id,"id"],
+						tag.name=JS.id[this.id,"tag"],
 						modifiers="checked",
 						guess.getter=guess.getter),
 						level=2, indent.by=indent.by))
-				})), collapse="\n"), sep="")
+				}, USE.NAMES=FALSE)), collapse="\n"), sep="")
 		} else {
 			JS.lines <- c(JS.lines, JS.special.id[,"id"])
 			names(JS.lines) <- NULL





More information about the rkward-tracker mailing list