[rkward-cvs] SF.net SVN: rkward-code:[4773] trunk/rkward/packages/XiMpLe

m-eik at users.sf.net m-eik at users.sf.net
Wed Mar 5 00:57:34 UTC 2014


Revision: 4773
          http://sourceforge.net/p/rkward/code/4773
Author:   m-eik
Date:     2014-03-05 00:57:33 +0000 (Wed, 05 Mar 2014)
Log Message:
-----------
code cleanup and regenereating the docs, trying to get roxygen2 3.1.0 to work... S4 is still a mess.

Modified Paths:
--------------
    trunk/rkward/packages/XiMpLe/ChangeLog
    trunk/rkward/packages/XiMpLe/DESCRIPTION
    trunk/rkward/packages/XiMpLe/NAMESPACE
    trunk/rkward/packages/XiMpLe/R/XMLNode.R
    trunk/rkward/packages/XiMpLe/R/XMLTree.R
    trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.R
    trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.roxy.all.R
    trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R
    trunk/rkward/packages/XiMpLe/R/parseXMLTree.R
    trunk/rkward/packages/XiMpLe/R/pasteXMLTag.R
    trunk/rkward/packages/XiMpLe/R/zzz_is_get_utils.R
    trunk/rkward/packages/XiMpLe/debian/changelog
    trunk/rkward/packages/XiMpLe/debian/control
    trunk/rkward/packages/XiMpLe/debian/copyright
    trunk/rkward/packages/XiMpLe/debian/rules
    trunk/rkward/packages/XiMpLe/inst/CITATION
    trunk/rkward/packages/XiMpLe/inst/NEWS.Rd
    trunk/rkward/packages/XiMpLe/man/XMLGetters-methods.Rd
    trunk/rkward/packages/XiMpLe/man/XMLNode.Rd
    trunk/rkward/packages/XiMpLe/man/XMLTree.Rd
    trunk/rkward/packages/XiMpLe/man/XiMpLe-package.Rd
    trunk/rkward/packages/XiMpLe/man/node.Rd
    trunk/rkward/packages/XiMpLe/man/parseXMLTree.Rd
    trunk/rkward/packages/XiMpLe/man/pasteXML-methods.Rd
    trunk/rkward/packages/XiMpLe/man/pasteXMLTag.Rd
    trunk/rkward/packages/XiMpLe/man/show-methods.Rd

Added Paths:
-----------
    trunk/rkward/packages/XiMpLe/R/00_class_01_XiMpLe.node.R
    trunk/rkward/packages/XiMpLe/R/00_class_02_XiMpLe.doc.R
    trunk/rkward/packages/XiMpLe/R/01_method_01_pasteXML.R
    trunk/rkward/packages/XiMpLe/R/01_method_02_node.R
    trunk/rkward/packages/XiMpLe/R/01_method_03_show.R

Removed Paths:
-------------
    trunk/rkward/packages/XiMpLe/R/XiMpLe.doc-class.R
    trunk/rkward/packages/XiMpLe/R/XiMpLe.node-class.R
    trunk/rkward/packages/XiMpLe/R/node.R
    trunk/rkward/packages/XiMpLe/R/pasteXML-methods.R
    trunk/rkward/packages/XiMpLe/R/show-methods.R

Modified: trunk/rkward/packages/XiMpLe/ChangeLog
===================================================================
--- trunk/rkward/packages/XiMpLe/ChangeLog	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/ChangeLog	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,6 +1,6 @@
 ChangeLog for package XiMpLe
 
-changes in version 0.03-21 (2013-12-21)
+changes in version 0.03-22 (2014-03-05)
 added:
   - new attribute "as.list" added to XMLScan(), if TRUE forces the return
     value to be a list of length 1 (default is still to directly return the

Modified: trunk/rkward/packages/XiMpLe/DESCRIPTION
===================================================================
--- trunk/rkward/packages/XiMpLe/DESCRIPTION	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/DESCRIPTION	2014-03-05 00:57:33 UTC (rev 4773)
@@ -19,19 +19,19 @@
 URL: http://reaktanz.de/?c=hacking&s=XiMpLe
 Authors at R: c(person(given="Meik", family="Michalke",
     email="meik.michalke at hhu.de", role=c("aut", "cre")))
-Version: 0.03-21
-Date: 2013-12-21
+Version: 0.03-22
+Date: 2014-03-05
 Collate:
+    '00_class_01_XiMpLe.node.R'
+    '00_class_02_XiMpLe.doc.R'
+    '01_method_01_pasteXML.R'
     'XiMpLe-internal.R'
-    'XiMpLe.node-class.R'
-    'XiMpLe.doc-class.R'
-    'node.R'
+    '01_method_02_node.R'
+    '01_method_03_show.R'
+    'XMLNode.R'
+    'XMLTree.R'
+    'XiMpLe-internal.roxy.all.R'
+    'XiMpLe-package.R'
     'parseXMLTree.R'
-    'pasteXML-methods.R'
     'pasteXMLTag.R'
-    'show-methods.R'
-    'XiMpLe-internal.roxy.all.R'
-    'XiMpLe-package.R'
-    'XMLNode.R'
-    'XMLTree.R'
     'zzz_is_get_utils.R'

Modified: trunk/rkward/packages/XiMpLe/NAMESPACE
===================================================================
--- trunk/rkward/packages/XiMpLe/NAMESPACE	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/NAMESPACE	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,32 +1,32 @@
+export("node<-")
+export(XMLNode)
+export(XMLTree)
+export(is.XiMpLe.doc)
+export(is.XiMpLe.node)
+export(node)
+export(parseXMLTree)
+export(pasteXML)
+export(pasteXMLNode)
+export(pasteXMLTag)
+export(pasteXMLTree)
 exportClasses(XiMpLe.doc)
 exportClasses(XiMpLe.node)
-export(is.XiMpLe.doc)
-export(is.XiMpLe.node)
-exportMethods(node)
-exportMethods("node<-")
-exportMethods(pasteXML)
-exportMethods(show)
-exportMethods(XMLAttrs)
 exportMethods("XMLAttrs<-")
-exportMethods(XMLChildren)
 exportMethods("XMLChildren<-")
-exportMethods(XMLDecl)
+exportMethods("XMLDTD<-")
 exportMethods("XMLDecl<-")
+exportMethods("XMLFile<-")
+exportMethods("XMLName<-")
+exportMethods("XMLScan<-")
+exportMethods("XMLValue<-")
+exportMethods(XMLAttrs)
+exportMethods(XMLChildren)
 exportMethods(XMLDTD)
-exportMethods("XMLDTD<-")
+exportMethods(XMLDecl)
 exportMethods(XMLFile)
-exportMethods("XMLFile<-")
 exportMethods(XMLName)
-exportMethods("XMLName<-")
 exportMethods(XMLScan)
-exportMethods("XMLScan<-")
 exportMethods(XMLScanDeep)
 exportMethods(XMLValue)
-exportMethods("XMLValue<-")
-export(parseXMLTree)
-export(pasteXMLNode)
-export(pasteXMLTag)
-export(pasteXMLTree)
-export(XMLNode)
-export(XMLTree)
+exportMethods(show)
 import(methods)

Added: trunk/rkward/packages/XiMpLe/R/00_class_01_XiMpLe.node.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/00_class_01_XiMpLe.node.R	                        (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/00_class_01_XiMpLe.node.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -0,0 +1,88 @@
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
+#
+# This file is part of the R package XiMpLe.
+#
+# XiMpLe is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# XiMpLe is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with XiMpLe.  If not, see <http://www.gnu.org/licenses/>.
+
+
+# Class XiMpLe.node
+#
+# This class is used to create DOM trees of XML documents, like objects that are returned
+# by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
+# 
+# There are certain special values predefined for the \code{name} slot to easily create special XML elements:
+# \describe{
+#     \item{\code{name=""}}{If the name is an empty character string, a pseudo node is created,
+#       \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}} will paste its \code{value} as plain text.}
+#     \item{\code{name="!--"}}{Creates a comment tag, i.e., this will comment out all its \code{children}.}
+#     \item{\code{name="![CDATA["}}{Creates a CDATA section and places all its \code{children} in it.}
+#     \item{\code{name="*![CDATA["}}{Creates a CDATA section and places all its \code{children} in it, where the CDATA markers are
+#       commented out by \code{/* */}, as is used for JavaScript in XHTML.}
+# }
+#
+# @slot name Name of the node (i.e., the XML tag identifier). For special names see details.
+# @slot attributes A list of named character values, representing the attributes of this node.
+# @slot children A list of further objects of class XiMpLe.node, representing child nodes of this node.
+# @slot value Plain text to be used as the enclosed value of this node. Set to \code{value=""} if you
+#    want a childless node to be forced into an non-empty pair of start and end tags by \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}}.
+# @name XiMpLe.node,-class
+# @aliases XiMpLe.node-class XiMpLe.node,-class
+#' @import methods
+# @keywords classes
+# @rdname XiMpLe.node-class
+#' @export
+
+setClass("XiMpLe.node",
+  representation=representation(
+    name="character",
+    attributes="list",
+    children="list",
+    value="character"
+  ),
+  prototype(
+    name=character(),
+    attributes=list(),
+    children=list(),
+    value=character()
+  )
+)
+
+setValidity("XiMpLe.node", function(object){
+    obj.name <- object at name
+    obj.attributes <- object at attributes
+    obj.children <- object at children
+    obj.value <- object at value
+
+    if(isTRUE(!nchar(obj.name) > 0) & isTRUE(!nchar(obj.value) > 0)){
+      print(str(object))
+      stop(simpleError("Invalid object: A node must at least have a name or a value!"))
+    } else {}
+
+    obj.attributes.names <- names(obj.attributes)
+    # if there are attributes, check that they all have names
+    if(length(obj.attributes) > 0){
+      if(length(obj.attributes) != length(obj.attributes.names)){
+        stop(simpleError("Invalid object: All attributes must have names!"))
+      } else {}
+    } else {}
+
+    # check content of children
+    if(length(obj.children) > 0){
+      child.nodes <- sapply(obj.children, function(this.child){is.XiMpLe.node(this.child)})
+      if(!all(child.nodes)){
+        stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
+      } else {}
+    } else {}
+  return(TRUE)
+})

Added: trunk/rkward/packages/XiMpLe/R/00_class_02_XiMpLe.doc.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/00_class_02_XiMpLe.doc.R	                        (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/00_class_02_XiMpLe.doc.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -0,0 +1,77 @@
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
+#
+# This file is part of the R package XiMpLe.
+#
+# XiMpLe is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# XiMpLe is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with XiMpLe.  If not, see <http://www.gnu.org/licenses/>.
+
+
+# Class XiMpLe.doc
+#
+# This class is used for objects that are returned by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
+#
+# @slot file Character string, Name of the file.
+# @slot xml A named list, XML declaration of the file.
+# @slot dtd A named list, Doctype definition of the file.
+# @slot children A list of objects of class XiMpLe.node, representing the DOM structure of the XML document.
+# @name XiMpLe.doc,-class
+# @aliases XiMpLe.doc-class XiMpLe.doc,-class
+#' @include 00_class_01_XiMpLe.node.R
+#' @import methods
+# @keywords classes
+# @rdname XiMpLe.doc-class
+#' @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){is.XiMpLe.node(this.child)})
+      if(!all(child.nodes)){
+        stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
+      } else {}
+    } else {}
+  return(TRUE)
+})

Added: trunk/rkward/packages/XiMpLe/R/01_method_01_pasteXML.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/01_method_01_pasteXML.R	                        (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/01_method_01_pasteXML.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -0,0 +1,156 @@
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
+#
+# This file is part of the R package XiMpLe.
+#
+# XiMpLe is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# XiMpLe is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with XiMpLe.  If not, see <http://www.gnu.org/licenses/>.
+
+
+#' Paste methods for XiMpLe XML objects
+#' 
+#' These methods can be used to paste objects if class \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
+#' or \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}.
+#'
+#' @note The functions pasteXMLNode() and pasteXMLTree() have been replaced by the pasteXML methods.
+#'    They should no longer be used.
+#'
+#' @param obj An object of class \code{XiMpLe.node} or \code{XiMpLe.doc}.
+#' @aliases
+#'    pasteXML,-methods
+#'    pasteXML,XiMpLe.doc-method
+#'    pasteXMLNode
+#'    pasteXMLTree
+#' @seealso \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}, 
+#'    \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+#' @keywords methods
+#' @rdname pasteXML-methods
+#' @include 00_class_01_XiMpLe.node.R
+#' @include 00_class_02_XiMpLe.doc.R
+#' @docType methods
+#' @export
+setGeneric("pasteXML", function(obj, ...) standardGeneric("pasteXML"))
+
+#' @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.
+#' @param tidy Logical, if \code{TRUE} the special characters "<" and ">" will be replaced with the entities
+#'    "<" and "gt;" in attributes and text values.
+#' @rdname pasteXML-methods
+#' @aliases
+#'    pasteXML,XiMpLe.node-method
+setMethod("pasteXML",
+  signature=signature(obj="XiMpLe.node"),
+  function(obj, level=1, shine=1, indent.by="\t", tidy=TRUE){
+
+    new.indent <- ifelse(shine > 0, indent(level+1, by=indent.by), "")
+    new.node   <- ifelse(shine > 0, "\n", "")
+
+    # get the slot contents
+    node.name <- slot(obj, "name")
+    node.attr <- slot(obj, "attributes")
+    node.chld <- slot(obj, "children")
+    node.val  <- slot(obj, "value")
+
+    if(!length(node.attr) > 0){
+      node.attr <- NULL
+    } else {}
+
+    if(length(node.chld) > 0){
+      node.chld <- paste0(unlist(sapply(node.chld, function(this.node){
+        if(slot(this.node, "name") == ""){
+          this.node.pasted <- paste0(new.indent, pasteXML(this.node, level=level, shine=shine, indent.by=indent.by, tidy=tidy))
+        } else {
+          this.node.pasted <- pasteXML(this.node, level=(level + 1), shine=shine, indent.by=indent.by, tidy=tidy)
+        }
+        return(this.node.pasted)})), collapse="")
+      node.empty <- FALSE
+    } else {
+      node.chld <- NULL
+      node.empty <- TRUE
+    }
+
+    # take care of text value
+    if(length(node.val) > 0){
+      node.empty <- FALSE
+      if(nchar(node.val) > 0){
+        if(isTRUE(tidy)){
+          node.val <- sapply(node.val, xml.tidy)
+        } else {}
+        node.chld <- paste0(node.chld, paste(node.val, new.node, collapse=" "))
+      } 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, tidy=tidy)
+    
+    return(pasted.node)
+  }
+)
+#' @rdname pasteXML-methods
+setMethod("pasteXML",
+  signature=signature(obj="XiMpLe.doc"),
+  function(obj, shine=1, indent.by="\t", tidy=TRUE){
+
+    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, tidy=tidy)
+      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", tree.doctype[["doctype"]], tree.doctype[["decl"]], sep=" ")
+      for (elmt in c("id", "refer")){
+        if(length(tree.doctype[[elmt]]) > 0) {
+          if(nchar(tree.doctype[[elmt]]) > 0){
+            doc.doctype <- paste0(doc.doctype, " \"",tree.doctype[[elmt]], "\"")
+          } else {}
+        } else {}
+      }
+      doc.doctype <- paste0(doc.doctype, ">", new.node)
+    } else {
+      doc.doctype <- ""
+    }
+
+    if(length(tree.nodes) > 0) {
+      doc.nodes <- paste0(unlist(sapply(tree.nodes, function(this.node){
+        return(pasteXML(this.node, level=1, shine=shine, indent.by=indent.by, tidy=tidy))})), collapse="")
+    } else {
+      doc.nodes <- ""
+    }
+
+    doc.all <- paste0(doc.xml, doc.doctype, doc.nodes, collapse="")
+
+    return(doc.all)
+  }
+)
+
+# for compatibility reasons, deploy wrapper functions
+#' @export
+pasteXMLNode <- function(node, level=1, shine=1, indent.by="\t", tidy=TRUE){
+  pasteXML(node, level=level, shine=shine, indent.by=indent.by, tidy=tidy)
+}
+#' @export
+pasteXMLTree <- function(obj, shine=1, indent.by="\t", tidy=TRUE){
+  pasteXML(obj, shine=shine, indent.by=indent.by, tidy=tidy)
+}

Added: trunk/rkward/packages/XiMpLe/R/01_method_02_node.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/01_method_02_node.R	                        (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/01_method_02_node.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -0,0 +1,242 @@
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
+#
+# This file is part of the R package XiMpLe.
+#
+# XiMpLe is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# XiMpLe is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with XiMpLe.  If not, see <http://www.gnu.org/licenses/>.
+
+
+#' 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.
+#'
+#' @include 00_class_01_XiMpLe.node.R
+#' @include 00_class_02_XiMpLe.doc.R
+#' @include XiMpLe-internal.R
+#' @import methods
+#' @examples
+#' \dontrun{
+#' node(my.xml.tree, node=list("html","body"), what="attributes")
+#' node(my.xml.tree, node=list("html","head","title"), what="value") <- "foobar"
+#' }
+#' @docType methods
+#' @rdname node
+#' @export
+setGeneric("node", function(obj, node=list(), what=NULL, cond.attr=NULL, cond.value=NULL, element=NULL){standardGeneric("node")})
+
+# define class union to make life easier
+#' @export
+setClassUnion("XiMpLe.XML", members=c("XiMpLe.node", "XiMpLe.doc"))
+
+#' @rdname node
+#' @aliases
+#'    node,-methods
+#'    node,XiMpLe.doc-method
+#'    node,XiMpLe.node-method
+#'    node,XiMpLe.XML-method
+#' @param obj An object of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}} or
+#'    \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}.
+#' @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{\link[XiMpLe:XiMpLe.node-class]{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.
+setMethod("node",
+  signature(obj="XiMpLe.XML"),
+  function(obj, node=list(), what=NULL, cond.attr=NULL, cond.value=NULL, element=NULL){
+
+    # check top level if this is a node, not a tree
+    if(is.XiMpLe.node(obj)){
+      got.this <- identical(slot(obj, "name"), node[[1]])
+      if(!isTRUE(got.this)){
+        # apparently, this node doesn't exist
+        stop(simpleError(paste0("Can't find node ", node[[1]], " in ", sQuote(deparse(substitute(obj))), "!")))
+      } else {
+        # remove first element in list node
+        node[[1]] <- NULL
+      }
+    } else {}
+    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 <- lapply(slot(this.node.part, "children"), function(this.child){slot(this.child, "name")}) %in% this.node
+        if(!any(got.this)){
+          # apparently, this node doesn't exist
+          stop(simpleError(paste0("Can't find node ", sQuote(this.node), " in ", sQuote(deparse(substitute(obj))), "!")))
+        } else {
+          result.node.path <- unique(paste0(result.node.path, paste0("@children[[",which(got.this),"]]")))
+        }
+      }
+    }
+
+    # 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(paste0("Invalid slot for class XiMpLe.node:", paste(sQuote(what), collapse=", "), "!")))
+      } 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)
+          # special case: text values can either be directly in the value slot of a node,
+          # or in a pseudo tag as a child node, so we check both
+          if(identical(what, "value")){
+            for (this.child in slot(this.node, "children")){
+                if(identical(slot(this.child, "name"), "") & isTRUE(nchar(slot(this.child, "value")) > 0))
+                  results <- paste(slot(this.child, "value"), results, sep=" ")
+              }
+          } else {}
+          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(is.XiMpLe.node(result[[1]]) | !is.null(element)){
+        result <- result[[1]]
+      } else {}
+    } else {}
+
+    return(result)
+  }
+)
+
+#' @export
+#' @rdname node
+setGeneric("node<-", function(obj, node=list(), what=NULL, cond.attr=NULL, cond.value=NULL, element=NULL, value){standardGeneric("node<-")})
+
+#' @rdname node
+#' @aliases
+#'    node<-,-methods
+#'    node<-,XiMpLe.doc-method
+#'    node<-,XiMpLe.node-method
+#'    node<-,XiMpLe.XML-method
+setMethod("node<-",
+  signature(obj="XiMpLe.XML"),
+  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)){
+      # special case: text values can either be directly in the value slot of a node,
+      # or in a pseudo tag as a child node, so we check both and remove all
+      if(identical(what, "value")){
+        eval(parse(text=paste0(this.node, "@value <- character()")))
+        all.node.children <- slot(eval(parse(text=this.node)), "children")
+        child.is.value <- sapply(all.node.children, function(this.child){
+            if(identical(slot(this.child, "name"), "") & isTRUE(nchar(slot(this.child, "value")) > 0)){
+              return(TRUE)
+            } else {
+              return(FALSE)
+            }
+          })
+        # if we have a mix of pseudo and actual tags, we probably messed up the markup
+        if(length(all.node.children) != length(child.is.value)){
+          warning("a child node contained text values and other nodes, we probably messed up the markup!")
+        } else {}
+        remove.nodes <- paste0(this.node, "@children[child.is.value] <- NULL")
+        eval(parse(text=remove.nodes))
+
+        # paste new value into a single pseudo node
+        pseudo.node <- paste0(this.node, "@children <- append(", this.node, "@children, ",
+          "new(\"XiMpLe.node\", name=\"\", value=\"", value, "\"), after=0)")
+        eval(parse(text=pseudo.node))
+
+        # now return the object
+        return(obj)
+      } else {
+        this.node <- paste0(this.node, "@", what)
+      }
+
+      if(!is.null(element)){
+        this.node <- paste0(this.node, "[[\"",element,"\"]]")
+      } else {}
+    } else {}
+
+    eval(parse(text=paste0(this.node, " <- ", deparse(value))))
+  }
+  
+    return(obj)
+  }
+)

Added: trunk/rkward/packages/XiMpLe/R/01_method_03_show.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/01_method_03_show.R	                        (rev 0)
+++ trunk/rkward/packages/XiMpLe/R/01_method_03_show.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -0,0 +1,41 @@
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
+#
+# This file is part of the R package XiMpLe.
+#
+# XiMpLe is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# XiMpLe is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with XiMpLe.  If not, see <http://www.gnu.org/licenses/>.
+
+
+#' Show method for S4 objects of XiMpLe XML classes
+#' 
+#' Used to display objects of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+#' and \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
+#'
+#' @param object An object of class \code{XiMpLe.doc} or \code{XiMpLe.node}
+#' @aliases
+#'    show,-methods
+#'    show,XiMpLe.doc-method
+#'    show,XiMpLe.node-method
+#'    show,XiMpLe.XML-method
+#' @seealso  
+#'    \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+#'    \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
+#' @keywords methods
+#' @docType methods
+#' @exportMethod show
+#' @rdname show-methods
+#' @include 00_class_01_XiMpLe.node.R
+#' @include 00_class_02_XiMpLe.doc.R
+setMethod("show", signature(object="XiMpLe.XML"), function(object){
+  cat(pasteXML(object))
+})

Modified: trunk/rkward/packages/XiMpLe/R/XMLNode.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XMLNode.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/XMLNode.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,4 +1,4 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
 #
 # This file is part of the R package XiMpLe.
 #
@@ -24,16 +24,16 @@
 #' 
 #' @param name Character string, the tag name.
 #' @param ... Optional children for the tag. Must be either objects of class XiMpLe.node or character strings,
-#'		which are treated as simple text values. If this is empty, the tag will be treated as an empty tag. To
-#'		force a closing tag, supply an empty string, i.e. \code{""}.
+#'    which are treated as simple text values. If this is empty, the tag will be treated as an empty tag. To
+#'    force a closing tag, supply an empty string, i.e. \code{""}.
 #' @param attrs An optional named list of attributes.
 #' @param namespace Currently ignored.
 #' @param namespaceDefinitions Currently ignored.
 #' @param .children Alternative way of specifying children, if you have them already as a list.
 #' @return An object of class \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}.
 #' @seealso
-#'		\code{\link[XiMpLe:XMLTree]{XMLTree}},
-#'		\code{\link[XiMpLe:pasteXML]{pasteXML}}
+#'    \code{\link[XiMpLe:XMLTree]{XMLTree}},
+#'    \code{\link[XiMpLe:pasteXML]{pasteXML}}
 #' @export
 #' @rdname XMLNode
 #' @examples
@@ -43,36 +43,36 @@
 
 XMLNode <- function(name, ..., attrs=NULL, namespace="", namespaceDefinitions=NULL, .children=list(...)){
 
-	all.children <- list()
+  all.children <- list()
 
-	# text node?
-	if(identical(name, "") &
-			(all(unlist(lapply(.children, is.character)))) |
-			all(unlist(lapply(.children, is.numeric)))){
-		value <- paste(..., sep=" ")
-	} else if(identical(.children, list(""))){
-		value <- ""
-	} else {
-		# remove NULLs
-		.children <- .children[unlist(lapply(.children, length) != 0)]
-		# check for text values
-		all.children <- sapply(child.list(.children), function(this.child){
-			if(is.character(this.child) | is.numeric(this.child)){
-				this.child <- new("XiMpLe.node",
-						name="",
-						value=as.character(this.child)
-					)
-			} else {}
-			return(this.child)
-		})
-		value <- character()
-	}
+  # text node?
+  if(identical(name, "") &
+      (all(unlist(lapply(.children, is.character)))) |
+      all(unlist(lapply(.children, is.numeric)))){
+    value <- paste(..., sep=" ")
+  } else if(identical(.children, list(""))){
+    value <- ""
+  } else {
+    # remove NULLs
+    .children <- .children[unlist(lapply(.children, length) != 0)]
+    # check for text values
+    all.children <- sapply(child.list(.children), function(this.child){
+      if(is.character(this.child) | is.numeric(this.child)){
+        this.child <- new("XiMpLe.node",
+            name="",
+            value=as.character(this.child)
+          )
+      } else {}
+      return(this.child)
+    })
+    value <- character()
+  }
 
-	newNode <- new("XiMpLe.node",
-		name=name,
-		attributes=as.list(attrs),
-		children=all.children,
-		value=value)
+  newNode <- new("XiMpLe.node",
+    name=name,
+    attributes=as.list(attrs),
+    children=all.children,
+    value=value)
 
-	return(newNode)
+  return(newNode)
 }

Modified: trunk/rkward/packages/XiMpLe/R/XMLTree.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XMLTree.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/XMLTree.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,4 +1,4 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
 #
 # This file is part of the R package XiMpLe.
 #
@@ -21,17 +21,17 @@
 #' Can be used to create full XML trees.
 #'
 #' @param ... Optional children for the XML tree. Must be either objects of class
-#'		\code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}} or character strings,
-#'		which are treated as simple text values.
+#'    \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}} or character strings,
+#'    which are treated as simple text values.
 #' @param xml A named list, XML declaration of the XML tree. Currently just pasted, no checking is done.
 #' @param dtd A named list, doctype definition of the XML tree. Valid elements are \code{doctype} (root element), \code{decl}
 #' ("PUBLIC" or "SYSTEM"), \code{id} (the identifier) and \code{refer} (URI to .dtd).
-#'		Currently just pasted, no checking is done.
+#'    Currently just pasted, no checking is done.
 #' @param .children Alternative way of specifying children, if you have them already as a list.
 #' @return An object of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
 #' @seealso
-#'		\code{\link[XiMpLe:XMLNode]{XMLNode}},
-#'		\code{\link[XiMpLe:pasteXML]{pasteXML}}
+#'    \code{\link[XiMpLe:XMLNode]{XMLNode}},
+#'    \code{\link[XiMpLe:pasteXML]{pasteXML}}
 #' @export
 #' @rdname XMLTree
 #' @examples
@@ -49,32 +49,32 @@
 
 XMLTree <- function(..., xml=NULL, dtd=NULL, .children=list(...)){
 
-	# remove NULLs
-	.children <- .children[unlist(lapply(.children, length) != 0)]
+  # remove NULLs
+  .children <- .children[unlist(lapply(.children, length) != 0)]
 
-	# check for text values
-	all.children <- sapply(child.list(.children), function(this.child){
-		if(is.character(this.child)){
-			this.child <- new("XiMpLe.node",
-					name="",
-					value=this.child
-				)
-		} else {}
-		return(this.child)
-	})
+  # check for text values
+  all.children <- sapply(child.list(.children), function(this.child){
+    if(is.character(this.child)){
+      this.child <- new("XiMpLe.node",
+          name="",
+          value=this.child
+        )
+    } else {}
+    return(this.child)
+  })
 
-	if(is.null(xml)){
-		xml <- list()
-	} else {}
-	if(is.null(dtd)){
-		dtd <- list()
-	} else {}
-	
-	newTree <- new("XiMpLe.doc",
-		xml=xml,
-		dtd=dtd,
-		children=all.children
-	)
+  if(is.null(xml)){
+    xml <- list()
+  } else {}
+  if(is.null(dtd)){
+    dtd <- list()
+  } else {}
+  
+  newTree <- new("XiMpLe.doc",
+    xml=xml,
+    dtd=dtd,
+    children=all.children
+  )
 
-	return(newTree)
+  return(newTree)
 }
\ No newline at end of file

Modified: trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,4 +1,4 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
 #
 # This file is part of the R package XiMpLe.
 #
@@ -20,70 +20,70 @@
 
 ## wrapper for paste0() needed?
 if(isTRUE(R_system_version(getRversion()) < 2.15)){
-	# if this is an older R version, we need a wrapper function for paste0()
-	# which was introduced with R 2.15 as a more efficient shortcut to paste(..., sep="")
-	paste0 <- function(..., collapse=NULL){
-		return(paste(..., sep="", collapse=collapse))
-	}
+  # if this is an older R version, we need a wrapper function for paste0()
+  # which was introduced with R 2.15 as a more efficient shortcut to paste(..., sep="")
+  paste0 <- function(..., collapse=NULL){
+    return(paste(..., sep="", collapse=collapse))
+  }
 } else {}
 
 
 ## function child.list()
 # convenience function to let single children be provided without list()
 child.list <- function(children){
-	if(is.XiMpLe.node(children)){
-		children <- list(children)
-	} else {
-		# if already a list, check if it's a list in a list and get it out
-		if(inherits(children, "list") & length(children) == 1){
-			if(inherits(children[[1]], "list")){
-				children <- children[[1]]
-			} else {}
-		} else {}
-	}
-	return(children)
+  if(is.XiMpLe.node(children)){
+    children <- list(children)
+  } else {
+    # if already a list, check if it's a list in a list and get it out
+    if(inherits(children, "list") & length(children) == 1){
+      if(inherits(children[[1]], "list")){
+        children <- children[[1]]
+      } else {}
+    } else {}
+  }
+  return(children)
 } ## end function child.list()
 
 
 ## function split.chars()
 # used to split a character string into parts at each occurrence of the start and end of a regex pattern
 split.chars <- function(txt, pattern, perl=FALSE){
-	found.pattern <- gregexpr(pattern, text=txt, perl=perl)
-	found.pattern.start <- found.pattern[[1]]
-	found.pattern.end <- found.pattern.start + attr(found.pattern[[1]], "match.length") - 1
-	# returned -1 if pattern wasn't found
-	if(found.pattern.start[1] == -1){
-		return(txt)
-	} else {
-		txt.length <- nchar(txt)
-		num.found.patterns <- length(found.pattern.start)
-		result <- unlist(sapply(0:num.found.patterns, function(pat.idx){
-				# 0: chars before first match
-				if(pat.idx == 0){
-					if(found.pattern.start[1] > 1){
-						return(substr(txt, 1, found.pattern.start[1] - 1))
-					} else {}
-				} else {
-					result.match <- substr(txt, found.pattern.start[pat.idx], found.pattern.end[pat.idx])
-					# check if there's stuff between two matches
-					aft.match <- found.pattern.end[pat.idx] + 1
-						if(pat.idx < num.found.patterns){
-							nxt.match <- found.pattern.start[pat.idx + 1]
-						} else {
-							nxt.match <- txt.length + 1
-						}
-					if(aft.match < nxt.match){
-						result.aft.match <- trim(substr(txt, aft.match, nxt.match - 1))
-						# remove empty space
-						if(!identical("", result.aft.match)){
-							result.match <- c(result.match, result.aft.match)
-						} else {}
-					} else {}
-					return(result.match)
-				}
-			}), use.names=FALSE)
-		return(result)
-	}
+  found.pattern <- gregexpr(pattern, text=txt, perl=perl)
+  found.pattern.start <- found.pattern[[1]]
+  found.pattern.end <- found.pattern.start + attr(found.pattern[[1]], "match.length") - 1
+  # returned -1 if pattern wasn't found
+  if(found.pattern.start[1] == -1){
+    return(txt)
+  } else {
+    txt.length <- nchar(txt)
+    num.found.patterns <- length(found.pattern.start)
+    result <- unlist(sapply(0:num.found.patterns, function(pat.idx){
+        # 0: chars before first match
+        if(pat.idx == 0){
+          if(found.pattern.start[1] > 1){
+            return(substr(txt, 1, found.pattern.start[1] - 1))
+          } else {}
+        } else {
+          result.match <- substr(txt, found.pattern.start[pat.idx], found.pattern.end[pat.idx])
+          # check if there's stuff between two matches
+          aft.match <- found.pattern.end[pat.idx] + 1
+            if(pat.idx < num.found.patterns){
+              nxt.match <- found.pattern.start[pat.idx + 1]
+            } else {
+              nxt.match <- txt.length + 1
+            }
+          if(aft.match < nxt.match){
+            result.aft.match <- trim(substr(txt, aft.match, nxt.match - 1))
+            # remove empty space
+            if(!identical("", result.aft.match)){
+              result.match <- c(result.match, result.aft.match)
+            } else {}
+          } else {}
+          return(result.match)
+        }
+      }), use.names=FALSE)
+    return(result)
+  }
 } ## end function split.chars()
 
 
@@ -92,50 +92,50 @@
 # - 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)
+  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.
-	tree <- split.chars(txt=tree, pattern="<!\\[CDATA\\[((?s).*?)\\]\\]>|/\\*[[:space:]]*<!\\[CDATA\\[[[:space:]]*\\*/((?s).*?)/\\*[[:space:]]*\\]\\]>[[:space:]]*\\*/|<!--((?s).*?)-->", perl=TRUE)
-	# now do the splitting
-	single.tags <- sapply(tree, function(this.tree){
-				# exclude the already cut our comments an CDATA entries
-				if(XML.comment(this.tree) | XML.cdata(this.tree) | XML.commcdata(this.tree)){
-					return(this.tree)
-				} else {
-					these.tags <- unlist(split.chars(txt=this.tree, "<((?s).*?)>", perl=TRUE), use.names=FALSE)
-					# remove probably troublesome content like newlines
-					these.tags[!XML.value(these.tags)] <- gsub("[[:space:]]+", " ", these.tags[!XML.value(these.tags)])
-					return(these.tags)
-				}
-			})
-	single.tags <- unlist(single.tags, use.names=FALSE)
-	single.tags <- as.character(single.tags)
+  ## the main splitting process
+  # CDATA or comments can contain stuff which might ruin the outcome. we'll deal with those parts first.
+  tree <- split.chars(txt=tree, pattern="<!\\[CDATA\\[((?s).*?)\\]\\]>|/\\*[[:space:]]*<!\\[CDATA\\[[[:space:]]*\\*/((?s).*?)/\\*[[:space:]]*\\]\\]>[[:space:]]*\\*/|<!--((?s).*?)-->", perl=TRUE)
+  # now do the splitting
+  single.tags <- sapply(tree, function(this.tree){
+        # exclude the already cut our comments an CDATA entries
+        if(XML.comment(this.tree) | XML.cdata(this.tree) | XML.commcdata(this.tree)){
+          return(this.tree)
+        } else {
+          these.tags <- unlist(split.chars(txt=this.tree, "<((?s).*?)>", perl=TRUE), use.names=FALSE)
+          # remove probably troublesome content like newlines
+          these.tags[!XML.value(these.tags)] <- gsub("[[:space:]]+", " ", these.tags[!XML.value(these.tags)])
+          return(these.tags)
+        }
+      })
+  single.tags <- unlist(single.tags, use.names=FALSE)
+  single.tags <- as.character(single.tags)
 
-	colnames(single.tags) <- NULL
-	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 {}
-	# force garbage collection
-	gc()
-	return(single.tags)
+  colnames(single.tags) <- NULL
+  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 {}
+  # force garbage collection
+  gc()
+  return(single.tags)
 } ## end function XML.single.tags()
 
 
@@ -143,26 +143,26 @@
 # takes a string, determines the minimum number of grouped \t strings,
 # and adjusts it globally to the given level
 setMinIndent <- function(tag, level=1, indent.by="\t", shine=0){
-	if(shine > 0){
-		tag <- gsub("\n([^\t])", "\n\t\\1", tag, perl=TRUE)
-	} else {}
-	currentMinIndent <- min(nchar(unlist(strsplit(tag, "[^\t]+"), use.names=FALSE)))
-	indentDiff <- currentMinIndent - level
-	# if currentMinIndent is greater than level, reduce indentation
-	if(indentDiff > 0){
-		tag <- gsub(paste0("(^|\n)(\t){", indentDiff, "}"), "\\1", tag, perl=TRUE)
-	} else if(indentDiff < 0){
-		tag <- gsub("(^|\n)(\t)", paste0("\\1", indent(level + 1, by=indent.by)), tag, perl=TRUE)
-	} else {}
+  if(shine > 0){
+    tag <- gsub("\n([^\t])", "\n\t\\1", tag, perl=TRUE)
+  } else {}
+  currentMinIndent <- min(nchar(unlist(strsplit(tag, "[^\t]+"), use.names=FALSE)))
+  indentDiff <- currentMinIndent - level
+  # if currentMinIndent is greater than level, reduce indentation
+  if(indentDiff > 0){
+    tag <- gsub(paste0("(^|\n)(\t){", indentDiff, "}"), "\\1", tag, perl=TRUE)
+  } else if(indentDiff < 0){
+    tag <- gsub("(^|\n)(\t)", paste0("\\1", indent(level + 1, by=indent.by)), tag, perl=TRUE)
+  } else {}
 
-	return(tag)
+  return(tag)
 } ## end function setMinIndent()
 
 
 ## function indent()
 # will create tabs to format the output
 indent <- function(level, by="\t"){
-	paste(rep(by, level-1), collapse="")
+  paste(rep(by, level-1), collapse="")
 } ## end function indent()
 
 
@@ -170,12 +170,12 @@
 # replace special character < and > from attributes or text values
 # with harmless entities
 xml.tidy <- function(text){
-	if(is.character(text)){
-		tidy.text <- gsub("<", "<", gsub(">", ">", gsub("&([#[:alnum:]]{7}[^;]|[[:space:]]|[^;]*$)", "&\\1", text, perl=TRUE)))
-	} else {
-		return(text)
-	}
-	return(tidy.text)
+  if(is.character(text)){
+    tidy.text <- gsub("<", "<", gsub(">", ">", gsub("&([#[:alnum:]]{7}[^;]|[[:space:]]|[^;]*$)", "&\\1", text, perl=TRUE)))
+  } else {
+    return(text)
+  }
+  return(tidy.text)
 } ## function xml.tidy()
 
 
@@ -183,380 +183,380 @@
 # 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)
+  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", tidy=FALSE){
-	if(is.null(attr)){
-		return("")
-	} else {}
+  if(is.null(attr)){
+    return("")
+  } else {}
 
-	if(isTRUE(tidy)){
-		attr <- sapply(attr, xml.tidy)
-	} else {}
+  if(isTRUE(tidy)){
+    attr <- sapply(attr, xml.tidy)
+  } else {}
 
-	new.indent <- ifelse(shine > 1, indent(level+1, by=indent.by), "")
-	new.attr   <- ifelse(shine > 1, "\n", " ")
+  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(paste0(full.attr, new.attr, new.indent, attr.name, "=\"", attr[[this.attr]], "\""))
-			} 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 <- paste0(attr.name, "=\"", attr[[1]], "\"")
-	}
-	return(full.attr)
+  # 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(paste0(full.attr, new.attr, new.indent, attr.name, "=\"", attr[[this.attr]], "\""))
+      } 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 <- paste0(attr.name, "=\"", attr[[1]], "\"")
+  }
+  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\", decl=\"\\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, paste0(stripped.tag2[!is.dtd][1]), paste0(""))
-		doct.ref <- ifelse(sum(is.dtd) > 0, paste0(stripped.tag2[is.dtd][1]), paste0(""))
-		parsed.list <- eval(parse(text=paste0("list(", stripped.tag, ", id=\"", doct.decl,"\"", ", refer=\"", doct.ref,"\")")))
-	} 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)
-		# to be on the safe side, escape all list names, in case there's unexpected special characters in them
-		separated.tag <- gsub("( ,)?([^[:space:],\"]*)=\"", "\\1\"\\2\"=\"", separated.tag, perl=TRUE)
-		###################################################################################
-		## TODO:
-		## empty attributes are not valid, force them into atrribute="attribute"
-		## does only work partially it the empty attribute is the last in line
-		## and still causes *problems* in matching string in the value of other attributes!
-		# separated.tag <- gsub("(, |\\A)([^[:space:],\"=][[:alnum:]]*)", "\\1\"\\2\"=\"\\2\"", separated.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 {}
+  if(XML.doctype(tag)){
+    stripped.tag <- gsub("<!((?i)DOCTYPE)[[:space:]]+([^[:space:]]+)[[:space:]]*([^\"[:space:]]*)[[:space:]]*.*>",
+      "doctype=\"\\2\", decl=\"\\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, paste0(stripped.tag2[!is.dtd][1]), paste0(""))
+    doct.ref <- ifelse(sum(is.dtd) > 0, paste0(stripped.tag2[is.dtd][1]), paste0(""))
+    parsed.list <- eval(parse(text=paste0("list(", stripped.tag, ", id=\"", doct.decl,"\"", ", refer=\"", doct.ref,"\")")))
+  } 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)
+    # to be on the safe side, escape all list names, in case there's unexpected special characters in them
+    separated.tag <- gsub("( ,)?([^[:space:],\"]*)=\"", "\\1\"\\2\"=\"", separated.tag, perl=TRUE)
+    ###################################################################################
+    ## TODO:
+    ## empty attributes are not valid, force them into atrribute="attribute"
+    ## does only work partially it the empty attribute is the last in line
+    ## and still causes *problems* in matching string in the value of other attributes!
+    # separated.tag <- gsub("(, |\\A)([^[:space:],\"=][[:alnum:]]*)", "\\1\"\\2\"=\"\\2\"", separated.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)
+  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)
+  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)
+  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.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("<!--((?s).*)-->", this.tag, perl=TRUE)
-			if(isTRUE(get)){
-				result <- ifelse(isTRUE(comment), gsub("<!--((?s).*)-->", "\\1", this.tag, perl=TRUE), "")
-				if(isTRUE(trim)){result <- trim(result)} else {}
-			} else {
-				result <- comment
-			}
-			return(result)
-		})
-	names(comment.tags) <- NULL
-	return(comment.tags)
+  comment.tags <- sapply(tag, function(this.tag){
+      comment <- grepl("<!--((?s).*)-->", this.tag, perl=TRUE)
+      if(isTRUE(get)){
+        result <- ifelse(isTRUE(comment), gsub("<!--((?s).*)-->", "\\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\\[((?s).*)\\]\\]>", this.tag, perl=TRUE)
-			if(isTRUE(get)){
-				result <- ifelse(isTRUE(cdata), gsub("<!\\[CDATA\\[((?s).*)\\]\\]>", "\\1", this.tag, perl=TRUE), "")
-				if(isTRUE(trim)){result <- trim(result)} else {}
-			} else {
-				result <- cdata
-			}
-			return(result)
-		})
-	names(cdata.tags) <- NULL
-	return(cdata.tags)
+  cdata.tags <- sapply(tag, function(this.tag){
+      cdata <- grepl("<!\\[CDATA\\[((?s).*)\\]\\]>", this.tag, perl=TRUE)
+      if(isTRUE(get)){
+        result <- ifelse(isTRUE(cdata), gsub("<!\\[CDATA\\[((?s).*)\\]\\]>", "\\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.commcdata()
 # checks if a tag is a /* CDATA */ declaration, returns TRUE or FALSE, or the data (TRUE & get=TRUE)
 XML.commcdata <- function(tag, get=FALSE, trim=TRUE){
-	commcdata.tags <- sapply(tag, function(this.tag){
-			commcdata <- grepl("/\\*[[:space:]]*<!\\[CDATA\\[[[:space:]]*\\*/((?s).*?)/\\*[[:space:]]*\\]\\]>[[:space:]]*\\*/", this.tag, perl=TRUE)
-			if(isTRUE(get)){
-				result <- ifelse(isTRUE(commcdata), gsub("/\\*[[:space:]]*<!\\[CDATA\\[[[:space:]]*\\*/((?s).*?)/\\*[[:space:]]*\\]\\]>[[:space:]]*\\*/", "\\1", this.tag, perl=TRUE), "")
-				if(isTRUE(trim)){result <- trim(result)} else {}
-			} else {
-				result <- commcdata
-			}
-			return(result)
-		})
-	names(commcdata.tags) <- NULL
-	return(commcdata.tags)
+  commcdata.tags <- sapply(tag, function(this.tag){
+      commcdata <- grepl("/\\*[[:space:]]*<!\\[CDATA\\[[[:space:]]*\\*/((?s).*?)/\\*[[:space:]]*\\]\\]>[[:space:]]*\\*/", this.tag, perl=TRUE)
+      if(isTRUE(get)){
+        result <- ifelse(isTRUE(commcdata), gsub("/\\*[[:space:]]*<!\\[CDATA\\[[[:space:]]*\\*/((?s).*?)/\\*[[:space:]]*\\]\\]>[[:space:]]*\\*/", "\\1", this.tag, perl=TRUE), "")
+        if(isTRUE(trim)){result <- trim(result)} else {}
+      } else {
+        result <- commcdata
+      }
+      return(result)
+    })
+  names(commcdata.tags) <- NULL
+  return(commcdata.tags)
 } ## end function XML.commcdata()
 
 ## 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)
+  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)
+  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)
+  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)
+  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)
+  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)
+  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){
-	# to save memory, we'll put the single.tags object into an environment
-	# and pass that on to all iterations
-	if(is.environment(single.tags)){
-		single.tags.env <- single.tags
-		num.all.tags <- length(get("single.tags", envir=single.tags.env))
-	} else {
-		single.tags.env <- new.env()
-		assign("single.tags", single.tags, envir=single.tags.env)
-		num.all.tags <- length(single.tags)
-	}
-	# try to iterate through the single tags
-	children <- list()
-	tag.no <- start
-	## uncomment to debug:
-	# cat(start,"\n")
-	while (tag.no <= num.all.tags){
-		## uncomment to debug:
-		# time.spent <- system.time({
-		this.tag <- get("single.tags", envir=single.tags.env)[tag.no]
-		nxt.child <- length(children) + 1
-		child.name <- XML.tagName(this.tag)
-		child.end.tag <- paste0("</[[:space:]]*", end.here,"[[:space:]>]+.*")
-		if(isTRUE(grepl(child.end.tag, this.tag))){
-		## uncomment to debug:
-		# cat(this.tag, ": break (",tag.no,")\n")
-			break
-		} else {}
-		# we must test for commented CDATA first, because XML.value() would be TRUE, too
-		if(XML.commcdata(this.tag)){
-			children[nxt.child] <- new("XiMpLe.node",
-				name="*![CDATA[",
-				value=XML.commcdata(this.tag, get=TRUE))
-			names(children)[nxt.child] <- "*![CDATA["
-			tag.no <- tag.no + 1
-			next
-		} else {}
-		if(XML.value(this.tag)){
-			children[nxt.child] <- new("XiMpLe.node",
-				name="",
-				value=XML.value(this.tag, get=TRUE))
-			names(children)[nxt.child] <- "!value!"
-			tag.no <- tag.no + 1
-			next
-		} else {
-			child.attr <- parseXMLAttr(this.tag)
-		}
-		if(XML.declaration(this.tag)){
-			children[nxt.child] <- new("XiMpLe.node",
-				name=child.name,
-				attributes=child.attr)
-			names(children)[nxt.child] <- child.name
-			tag.no <- tag.no + 1
-			next
-		} else {}
-		if(XML.comment(this.tag)){
-			children[nxt.child] <- new("XiMpLe.node",
-				name="!--",
-				value=XML.comment(this.tag, get=TRUE))
-			names(children)[nxt.child] <- "!--"
-			tag.no <- tag.no + 1
-			next
-		} else {}
-		if(XML.cdata(this.tag)){
-			children[nxt.child] <- new("XiMpLe.node",
-				name="![CDATA[",
-				value=XML.cdata(this.tag, get=TRUE))
-			names(children)[nxt.child] <- "![CDATA["
-			tag.no <- tag.no + 1
-			next
-		} else {}
-		if(XML.endTag(this.tag)){
-			break
-		} else {}
-		if(!XML.emptyTag(this.tag)){
-		## uncomment to debug:
-		# cat(child.name, ":", tag.no, "-", child.end.tag,"\n")
-			rec.nodes <- XML.nodes(single.tags.env, end.here=child.name, start=tag.no + 1)
-			children[nxt.child] <- new("XiMpLe.node",
-				name=child.name,
-				attributes=child.attr,
-				children=rec.nodes$children,
-				# this value will force the node to remain non-empty if it had no children,
-				# it would be turned into an empty tag otherwise
-				value="")
-			names(children)[nxt.child] <- child.name
-			tag.no <- rec.nodes$tag.no + 1
-			next
-		} else {
-			children[nxt.child] <- new("XiMpLe.node",
-				name=child.name,
-				attributes=child.attr)
-			names(children)[nxt.child] <- child.name
-			tag.no <- tag.no + 1
-			next
-		}
-		## uncomment to debug:
-		# })
-		# cat("system.time:", time.spent, "\n")
-	}
-	return(list(children=children, tag.no=tag.no))
+  # to save memory, we'll put the single.tags object into an environment
+  # and pass that on to all iterations
+  if(is.environment(single.tags)){
+    single.tags.env <- single.tags
+    num.all.tags <- length(get("single.tags", envir=single.tags.env))
+  } else {
+    single.tags.env <- new.env()
+    assign("single.tags", single.tags, envir=single.tags.env)
+    num.all.tags <- length(single.tags)
+  }
+  # try to iterate through the single tags
+  children <- list()
+  tag.no <- start
+  ## uncomment to debug:
+  # cat(start,"\n")
+  while (tag.no <= num.all.tags){
+    ## uncomment to debug:
+    # time.spent <- system.time({
+    this.tag <- get("single.tags", envir=single.tags.env)[tag.no]
+    nxt.child <- length(children) + 1
+    child.name <- XML.tagName(this.tag)
+    child.end.tag <- paste0("</[[:space:]]*", end.here,"[[:space:]>]+.*")
+    if(isTRUE(grepl(child.end.tag, this.tag))){
+    ## uncomment to debug:
+    # cat(this.tag, ": break (",tag.no,")\n")
+      break
+    } else {}
+    # we must test for commented CDATA first, because XML.value() would be TRUE, too
+    if(XML.commcdata(this.tag)){
+      children[nxt.child] <- new("XiMpLe.node",
+        name="*![CDATA[",
+        value=XML.commcdata(this.tag, get=TRUE))
+      names(children)[nxt.child] <- "*![CDATA["
+      tag.no <- tag.no + 1
+      next
+    } else {}
+    if(XML.value(this.tag)){
+      children[nxt.child] <- new("XiMpLe.node",
+        name="",
+        value=XML.value(this.tag, get=TRUE))
+      names(children)[nxt.child] <- "!value!"
+      tag.no <- tag.no + 1
+      next
+    } else {
+      child.attr <- parseXMLAttr(this.tag)
+    }
+    if(XML.declaration(this.tag)){
+      children[nxt.child] <- new("XiMpLe.node",
+        name=child.name,
+        attributes=child.attr)
+      names(children)[nxt.child] <- child.name
+      tag.no <- tag.no + 1
+      next
+    } else {}
+    if(XML.comment(this.tag)){
+      children[nxt.child] <- new("XiMpLe.node",
+        name="!--",
+        value=XML.comment(this.tag, get=TRUE))
+      names(children)[nxt.child] <- "!--"
+      tag.no <- tag.no + 1
+      next
+    } else {}
+    if(XML.cdata(this.tag)){
+      children[nxt.child] <- new("XiMpLe.node",
+        name="![CDATA[",
+        value=XML.cdata(this.tag, get=TRUE))
+      names(children)[nxt.child] <- "![CDATA["
+      tag.no <- tag.no + 1
+      next
+    } else {}
+    if(XML.endTag(this.tag)){
+      break
+    } else {}
+    if(!XML.emptyTag(this.tag)){
+    ## uncomment to debug:
+    # cat(child.name, ":", tag.no, "-", child.end.tag,"\n")
+      rec.nodes <- XML.nodes(single.tags.env, end.here=child.name, start=tag.no + 1)
+      children[nxt.child] <- new("XiMpLe.node",
+        name=child.name,
+        attributes=child.attr,
+        children=rec.nodes$children,
+        # this value will force the node to remain non-empty if it had no children,
+        # it would be turned into an empty tag otherwise
+        value="")
+      names(children)[nxt.child] <- child.name
+      tag.no <- rec.nodes$tag.no + 1
+      next
+    } else {
+      children[nxt.child] <- new("XiMpLe.node",
+        name=child.name,
+        attributes=child.attr)
+      names(children)[nxt.child] <- child.name
+      tag.no <- tag.no + 1
+      next
+    }
+    ## uncomment to debug:
+    # })
+    # cat("system.time:", time.spent, "\n")
+  }
+  return(list(children=children, tag.no=tag.no))
 } ## end function XML.nodes()

Modified: trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.roxy.all.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.roxy.all.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe-internal.roxy.all.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,4 +1,4 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
 #
 # This file is part of the R package XiMpLe.
 #
@@ -20,22 +20,22 @@
 # this internal object can be used by the package roxyPackage to
 # automatically create/update DESCRIPTION and CITATION files
 pckg.dscrptn <- data.frame(
-		Package="XiMpLe",
-		Type="Package",
-		Title="A simple XML tree parser and generator",
-		Author="m.eik michalke",
-		AuthorsR="c(person(given=\"Meik\", family=\"Michalke\", email=\"meik.michalke at hhu.de\",
-			role=c(\"aut\", \"cre\")))",
-		Maintainer="m.eik michalke <meik.michalke at hhu.de>",
-		Depends="R (>= 2.9.0),methods",
-		Suggests="testthat",
-		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://reaktanz.de/?c=hacking&s=XiMpLe",
-		stringsAsFactors=FALSE)
+    Package="XiMpLe",
+    Type="Package",
+    Title="A simple XML tree parser and generator",
+    Author="m.eik michalke",
+    AuthorsR="c(person(given=\"Meik\", family=\"Michalke\", email=\"meik.michalke at hhu.de\",
+      role=c(\"aut\", \"cre\")))",
+    Maintainer="m.eik michalke <meik.michalke at hhu.de>",
+    Depends="R (>= 2.9.0),methods",
+    Suggests="testthat",
+    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://reaktanz.de/?c=hacking&s=XiMpLe",
+    stringsAsFactors=FALSE)

Modified: trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe-package.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -3,8 +3,8 @@
 #' \tabular{ll}{
 #' Package: \tab XiMpLe\cr
 #' Type: \tab Package\cr
-#' Version: \tab 0.03-21\cr
-#' Date: \tab 2013-12-21\cr
+#' Version: \tab 0.03-22\cr
+#' Date: \tab 2014-03-05\cr
 #' Depends: \tab R (>= 2.9.0),methods\cr
 #' Enhances: \tab rkward\cr
 #' Encoding: \tab UTF-8\cr

Deleted: trunk/rkward/packages/XiMpLe/R/XiMpLe.doc-class.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe.doc-class.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe.doc-class.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,83 +0,0 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
-#
-# This file is part of the R package XiMpLe.
-#
-# XiMpLe is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-#
-# XiMpLe is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with XiMpLe.  If not, see <http://www.gnu.org/licenses/>.
-
-
-## temporarily turned off most of the roxygen comments
-## class docs will remain static until roxygen2 supports "@slot"
-
-# Class XiMpLe.doc
-#
-# This class is used for objects that are returned by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
-#
-# @title S4 class XiMpLe.doc
-# @slot file Character string, Name of the file.
-# @slot xml A named list, XML declaration of the file.
-# @slot dtd A named list, Doctype definition of the file.
-# @slot children A list of objects of class XiMpLe.node, representing the DOM structure of the XML document.
-# @name XiMpLe.doc,-class
-# @aliases XiMpLe.doc-class XiMpLe.doc,-class
-#' @include XiMpLe.node-class.R
-#' @import methods
-# @keywords classes
-#' @noRd
-# @rdname XiMpLe.doc-class
-# @exportClass XiMpLe.doc
-#' @export
-
-setClass("XiMpLe.doc",
-	representation=representation(
-		file="character",
-		xml="list",
-		dtd="list",
-		children="list"
-	),
-	prototype(
-		file=character(),
-		xml=list(),
-		dtd=list(),
-		children=list()
-	)
-)
-
-setValidity("XiMpLe.doc", function(object){
-		obj.xml <- object at xml
-		obj.dtd <- object at dtd
-		obj.children <- object at children
-
-		obj.xml.names <- names(obj.xml)
-		obj.dtd.names <- names(obj.dtd)
-		# if there are declarations, check that they all have names
-		if(length(obj.xml) > 0){
-			if(length(obj.xml) != length(obj.xml.names)){
-				stop(simpleError("Invalid object: All xml declarations must have names!"))
-			} else {}
-		} else {}
-		if(length(obj.dtd) > 0){
-			if(length(obj.dtd) != length(obj.dtd.names)){
-				stop(simpleError("Invalid object: All doctype declarations must have names!"))
-			} else {}
-		} else {}
-
-		# check content of children
-		if(length(obj.children) > 0){
-			child.nodes <- sapply(obj.children, function(this.child){is.XiMpLe.node(this.child)})
-			if(!all(child.nodes)){
-				stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
-			} else {}
-		} else {}
-	return(TRUE)
-})

Deleted: trunk/rkward/packages/XiMpLe/R/XiMpLe.node-class.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/XiMpLe.node-class.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/XiMpLe.node-class.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,92 +0,0 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
-#
-# This file is part of the R package XiMpLe.
-#
-# XiMpLe is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-#
-# XiMpLe is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with XiMpLe.  If not, see <http://www.gnu.org/licenses/>.
-
-
-# Class XiMpLe.node
-#
-# This class is used to create DOM trees of XML documents, like objects that are returned
-# by \code{\link[XiMpLe:parseXMLTree]{parseXMLTree}}.
-# 
-# There are certain special values predefined for the \code{name} slot to easily create special XML elements:
-# \describe{
-# 		\item{\code{name=""}}{If the name is an empty character string, a pseudo node is created,
-# 			\code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}} will paste its \code{value} as plain text.}
-# 		\item{\code{name="!--"}}{Creates a comment tag, i.e., this will comment out all its \code{children}.}
-# 		\item{\code{name="![CDATA["}}{Creates a CDATA section and places all its \code{children} in it.}
-# 		\item{\code{name="*![CDATA["}}{Creates a CDATA section and places all its \code{children} in it, where the CDATA markers are
-# 			commented out by \code{/* */}, as is used for JavaScript in XHTML.}
-# }
-#
-# @title S4 class XiMpLe.node
-# @slot name Name of the node (i.e., the XML tag identifier). For special names see details.
-# @slot attributes A list of named character values, representing the attributes of this node.
-# @slot children A list of further objects of class XiMpLe.node, representing child nodes of this node.
-# @slot value Plain text to be used as the enclosed value of this node. Set to \code{value=""} if you
-#		want a childless node to be forced into an non-empty pair of start and end tags by \code{\link[XiMpLe:pasteXMLNode]{pasteXMLNode}}.
-# @name XiMpLe.node,-class
-# @aliases XiMpLe.node-class XiMpLe.node,-class
-#' @import methods
-# @keywords classes
-#' @noRd
-# @rdname XiMpLe.node-class
-#' @include XiMpLe.doc-class.R
-# @exportClass XiMpLe.node
-#' @export
-
-setClass("XiMpLe.node",
-	representation=representation(
-		name="character",
-		attributes="list",
-		children="list",
-		value="character"
-	),
-	prototype(
-		name=character(),
-		attributes=list(),
-		children=list(),
-		value=character()
-	)
-)
-
-setValidity("XiMpLe.node", function(object){
-		obj.name <- object at name
-		obj.attributes <- object at attributes
-		obj.children <- object at children
-		obj.value <- object at value
-
-		if(isTRUE(!nchar(obj.name) > 0) & isTRUE(!nchar(obj.value) > 0)){
-			print(str(object))
-			stop(simpleError("Invalid object: A node must at least have a name or a value!"))
-		} else {}
-
-		obj.attributes.names <- names(obj.attributes)
-		# if there are attributes, check that they all have names
-		if(length(obj.attributes) > 0){
-			if(length(obj.attributes) != length(obj.attributes.names)){
-				stop(simpleError("Invalid object: All attributes must have names!"))
-			} else {}
-		} else {}
-
-		# check content of children
-		if(length(obj.children) > 0){
-			child.nodes <- sapply(obj.children, function(this.child){is.XiMpLe.node(this.child)})
-			if(!all(child.nodes)){
-				stop(simpleError("Invalid object: All list elements of children must be of class XiMpLe.node!"))
-			} else {}
-		} else {}
-	return(TRUE)
-})

Deleted: trunk/rkward/packages/XiMpLe/R/node.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/node.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/node.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,240 +0,0 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
-#
-# This file is part of the R package XiMpLe.
-#
-# XiMpLe is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-#
-# XiMpLe is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with XiMpLe.  If not, see <http://www.gnu.org/licenses/>.
-
-
-#' 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.
-#'
-#' @include XiMpLe.doc-class.R
-#' @include XiMpLe.node-class.R
-#' @include XiMpLe-internal.R
-#' @import methods
-#' @examples
-#' \dontrun{
-#' node(my.xml.tree, node=list("html","body"), what="attributes")
-#' node(my.xml.tree, node=list("html","head","title"), what="value") <- "foobar"
-#' }
-#' @docType methods
-#' @rdname node
-#' @export
-setGeneric("node", function(obj, node=list(), what=NULL, cond.attr=NULL, cond.value=NULL, element=NULL){standardGeneric("node")})
-
-# define class union to make life easier
-setClassUnion("XiMpLe.XML", members=c("XiMpLe.node", "XiMpLe.doc"))
-
-#' @rdname node
-#' @aliases
-#'		node,-methods
-#'		node,XiMpLe.doc-method
-#'		node,XiMpLe.node-method
-#'		node,XiMpLe.XML-method
-#' @param obj An object of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}} or
-#'		\code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}.
-#' @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{\link[XiMpLe:XiMpLe.node-class]{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.
-setMethod("node",
-	signature(obj="XiMpLe.XML"),
-	function(obj, node=list(), what=NULL, cond.attr=NULL, cond.value=NULL, element=NULL){
-
-		# check top level if this is a node, not a tree
-		if(is.XiMpLe.node(obj)){
-			got.this <- identical(slot(obj, "name"), node[[1]])
-			if(!isTRUE(got.this)){
-				# apparently, this node doesn't exist
-				stop(simpleError(paste0("Can't find node ", node[[1]], " in ", sQuote(deparse(substitute(obj))), "!")))
-			} else {
-				# remove first element in list node
-				node[[1]] <- NULL
-			}
-		} else {}
-		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 <- lapply(slot(this.node.part, "children"), function(this.child){slot(this.child, "name")}) %in% this.node
-				if(!any(got.this)){
-					# apparently, this node doesn't exist
-					stop(simpleError(paste0("Can't find node ", sQuote(this.node), " in ", sQuote(deparse(substitute(obj))), "!")))
-				} else {
-					result.node.path <- unique(paste0(result.node.path, paste0("@children[[",which(got.this),"]]")))
-				}
-			}
-		}
-
-		# 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(paste0("Invalid slot for class XiMpLe.node:", paste(sQuote(what), collapse=", "), "!")))
-			} 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)
-					# special case: text values can either be directly in the value slot of a node,
-					# or in a pseudo tag as a child node, so we check both
-					if(identical(what, "value")){
-						for (this.child in slot(this.node, "children")){
-								if(identical(slot(this.child, "name"), "") & isTRUE(nchar(slot(this.child, "value")) > 0))
-									results <- paste(slot(this.child, "value"), results, sep=" ")
-							}
-					} else {}
-					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(is.XiMpLe.node(result[[1]]) | !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<-")})
-
-#' @rdname node
-#' @aliases
-#'		node<-,-methods
-#'		node<-,XiMpLe.doc-method
-#'		node<-,XiMpLe.node-method
-#'		node<-,XiMpLe.XML-method
-setMethod("node<-",
-	signature(obj="XiMpLe.XML"),
-	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)){
-			# special case: text values can either be directly in the value slot of a node,
-			# or in a pseudo tag as a child node, so we check both and remove all
-			if(identical(what, "value")){
-				eval(parse(text=paste0(this.node, "@value <- character()")))
-				all.node.children <- slot(eval(parse(text=this.node)), "children")
-				child.is.value <- sapply(all.node.children, function(this.child){
-						if(identical(slot(this.child, "name"), "") & isTRUE(nchar(slot(this.child, "value")) > 0)){
-							return(TRUE)
-						} else {
-							return(FALSE)
-						}
-					})
-				# if we have a mix of pseudo and actual tags, we probably messed up the markup
-				if(length(all.node.children) != length(child.is.value)){
-					warning("a child node contained text values and other nodes, we probably messed up the markup!")
-				} else {}
-				remove.nodes <- paste0(this.node, "@children[child.is.value] <- NULL")
-				eval(parse(text=remove.nodes))
-
-				# paste new value into a single pseudo node
-				pseudo.node <- paste0(this.node, "@children <- append(", this.node, "@children, ",
-					"new(\"XiMpLe.node\", name=\"\", value=\"", value, "\"), after=0)")
-				eval(parse(text=pseudo.node))
-
-				# now return the object
-				return(obj)
-			} else {
-				this.node <- paste0(this.node, "@", what)
-			}
-
-			if(!is.null(element)){
-				this.node <- paste0(this.node, "[[\"",element,"\"]]")
-			} else {}
-		} else {}
-
-		eval(parse(text=paste0(this.node, " <- ", deparse(value))))
-	}
-	
-		return(obj)
-	}
-)

Modified: trunk/rkward/packages/XiMpLe/R/parseXMLTree.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/parseXMLTree.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/parseXMLTree.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,4 +1,4 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
 #
 # This file is part of the R package XiMpLe.
 #
@@ -20,22 +20,22 @@
 #'
 #' @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.
+#'    \code{"declarations"} and \code{"doctype"}, defining element classes to be dropped
+#'    from the resulting object.
 #' @param object Logical, if \code{TRUE}, \code{file} will not be treated as a path name but as a
-#'		character vector to be parsed as XML directly.
+#'    character vector to be parsed as XML directly.
 #' @return An object of class \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}} with four slots:
-#'		\describe{
-#'			\item{\code{file}:}{Full path to the parsed file, or \code{"object"} if \code{object=TRUE}.}
-#'			\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).}
-#'		}
+#'    \describe{
+#'      \item{\code{file}:}{Full path to the parsed file, or \code{"object"} if \code{object=TRUE}.}
+#'      \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).}
+#'    }
 #' @seealso \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}},
-#'		\code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+#'    \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
 #' @export
 #' @examples
 #' \dontrun{
@@ -43,46 +43,46 @@
 #' }
 
 parseXMLTree <- function(file, drop=NULL, object=FALSE){
-	if(isTRUE(object)){
-		xml.raw <- paste(file, collapse="\n")
-		filePath <- "object"
-	} else if(inherits(file, "connection")){
-		xml.raw <- paste(readLines(file), collapse="\n")
-		# is there a way to get the friggin' "description" out of a connection object?!
-		filePath <- "connection"
-	} else {
-		xml.raw <- paste(readLines(file), collapse="\n")
-		# try to detect if 'file' is like a weblink, not a regular file
-		if(grepl("^[[:alpha:]]+://", file, ignore.case=TRUE)){
-			filePath <- file
-		} else {
-			filePath <- normalizePath(file)
-		}
-	}
+  if(isTRUE(object)){
+    xml.raw <- paste(file, collapse="\n")
+    filePath <- "object"
+  } else if(inherits(file, "connection")){
+    xml.raw <- paste(readLines(file), collapse="\n")
+    # is there a way to get the friggin' "description" out of a connection object?!
+    filePath <- "connection"
+  } else {
+    xml.raw <- paste(readLines(file), collapse="\n")
+    # try to detect if 'file' is like a weblink, not a regular file
+    if(grepl("^[[:alpha:]]+://", file, ignore.case=TRUE)){
+      filePath <- file
+    } else {
+      filePath <- normalizePath(file)
+    }
+  }
 
-	single.tags <- XML.single.tags(xml.raw, drop=drop)
+  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=filePath,
-		xml=XML.decl,
-		dtd=XML.doct,
-		children=children)
-	
-	return(results)
+  # 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=filePath,
+    xml=XML.decl,
+    dtd=XML.doct,
+    children=children)
+  
+  return(results)
 }

Deleted: trunk/rkward/packages/XiMpLe/R/pasteXML-methods.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/pasteXML-methods.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/pasteXML-methods.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,161 +0,0 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
-#
-# This file is part of the R package XiMpLe.
-#
-# XiMpLe is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-#
-# XiMpLe is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with XiMpLe.  If not, see <http://www.gnu.org/licenses/>.
-
-
-#' Paste methods for XiMpLe XML objects
-#' 
-#' These methods can be used to paste objects if class \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
-#' or \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}.
-#'
-#' @note The functions pasteXMLNode() and pasteXMLTree() have been replaced by the pasteXML methods.
-#'		They should no longer be used.
-#'
-#' @param obj An object of class \code{XiMpLe.node} or \code{XiMpLe.doc}.
-#' @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.
-#' @param tidy Logical, if \code{TRUE} the special characters "<" and ">" will be replaced with the entities
-#'		"<" and "gt;" in attributes and text values.
-#' @aliases
-#'		pasteXML,-methods
-#'		pasteXML,XiMpLe.doc-method
-#'		pasteXMLNode
-#'		pasteXMLTree
-#' @seealso \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}, 
-#'		\code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
-#' @keywords methods
-#' @rdname pasteXML-methods
-#' @include XiMpLe.node-class.R
-#' @include XiMpLe.doc-class.R
-#' @exportMethod pasteXML
-setGeneric("pasteXML", function(obj, ...) standardGeneric("pasteXML"))
-
-#' @usage pasteXML(obj, level=1, shine=1, indent.by="\t", tidy=TRUE)
-#' @rdname pasteXML-methods
-#' @aliases
-#'		pasteXML,XiMpLe.node-method
-#' @export
-setMethod("pasteXML",
-	signature=signature(obj="XiMpLe.node"),
-	function(obj, level=1, shine=1, indent.by="\t", tidy=TRUE){
-
-		new.indent <- ifelse(shine > 0, indent(level+1, by=indent.by), "")
-		new.node   <- ifelse(shine > 0, "\n", "")
-
-		# get the slot contents
-		node.name <- slot(obj, "name")
-		node.attr <- slot(obj, "attributes")
-		node.chld <- slot(obj, "children")
-		node.val  <- slot(obj, "value")
-
-		if(!length(node.attr) > 0){
-			node.attr <- NULL
-		} else {}
-
-		if(length(node.chld) > 0){
-			node.chld <- paste0(unlist(sapply(node.chld, function(this.node){
-				if(slot(this.node, "name") == ""){
-					this.node.pasted <- paste0(new.indent, pasteXML(this.node, level=level, shine=shine, indent.by=indent.by, tidy=tidy))
-				} else {
-					this.node.pasted <- pasteXML(this.node, level=(level + 1), shine=shine, indent.by=indent.by, tidy=tidy)
-				}
-				return(this.node.pasted)})), collapse="")
-			node.empty <- FALSE
-		} else {
-			node.chld <- NULL
-			node.empty <- TRUE
-		}
-
-		# take care of text value
-		if(length(node.val) > 0){
-			node.empty <- FALSE
-			if(nchar(node.val) > 0){
-				if(isTRUE(tidy)){
-					node.val <- sapply(node.val, xml.tidy)
-				} else {}
-				node.chld <- paste0(node.chld, paste(node.val, new.node, collapse=" "))
-			} 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, tidy=tidy)
-		
-		return(pasted.node)
-	}
-)
-#' @usage
-#' 	# S4 method for objects of class XiMpLe.doc
-#'		pasteXML(obj, shine=1, indent.by="\t", tidy=TRUE)
-#' @rdname pasteXML-methods
-#' @export
-setMethod("pasteXML",
-	signature=signature(obj="XiMpLe.doc"),
-	function(obj, shine=1, indent.by="\t", tidy=TRUE){
-
-		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, tidy=tidy)
-			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", tree.doctype[["doctype"]], tree.doctype[["decl"]], sep=" ")
-			for (elmt in c("id", "refer")){
-				if(length(tree.doctype[[elmt]]) > 0) {
-					if(nchar(tree.doctype[[elmt]]) > 0){
-						doc.doctype <- paste0(doc.doctype, " \"",tree.doctype[[elmt]], "\"")
-					} else {}
-				} else {}
-			}
-			doc.doctype <- paste0(doc.doctype, ">", new.node)
-		} else {
-			doc.doctype <- ""
-		}
-
-		if(length(tree.nodes) > 0) {
-			doc.nodes <- paste0(unlist(sapply(tree.nodes, function(this.node){
-				return(pasteXML(this.node, level=1, shine=shine, indent.by=indent.by, tidy=tidy))})), collapse="")
-		} else {
-			doc.nodes <- ""
-		}
-
-		doc.all <- paste0(doc.xml, doc.doctype, doc.nodes, collapse="")
-
-		return(doc.all)
-	}
-)
-
-# for compatibility reasons, deploy wrapper functions
-#' @export
-pasteXMLNode <- function(node, level=1, shine=1, indent.by="\t", tidy=TRUE){
-	pasteXML(node, level=level, shine=shine, indent.by=indent.by, tidy=tidy)
-}
-#' @export
-pasteXMLTree <- function(obj, shine=1, indent.by="\t", tidy=TRUE){
-	pasteXML(obj, shine=shine, indent.by=indent.by, tidy=tidy)
-}

Modified: trunk/rkward/packages/XiMpLe/R/pasteXMLTag.R
===================================================================
--- trunk/rkward/packages/XiMpLe/R/pasteXMLTag.R	2013-12-21 19:33:05 UTC (rev 4772)
+++ trunk/rkward/packages/XiMpLe/R/pasteXMLTag.R	2014-03-05 00:57:33 UTC (rev 4773)
@@ -1,4 +1,4 @@
-# Copyright 2011-2013 Meik Michalke <meik.michalke at hhu.de>
+# Copyright 2011-2014 Meik Michalke <meik.michalke at hhu.de>
 #
 # This file is part of the R package XiMpLe.
 #
@@ -23,8 +23,8 @@
 #' with this one function.
 #' 
 #' @note However, you will probably not want to use this function at all, as it is much more
-#' 	comfortable to create XML nodes or even nested trees with \code{\link[XiMpLe:XMLNode]{XMLNode}} and
-#' 	\code{\link[XiMpLe:XMLTree]{XMLTree}}, and then feed the result to \code{\link[XiMpLe:pasteXML]{pasteXML}}.

@@ Diff output truncated at 100000 characters. @@




More information about the rkward-tracker mailing list