USER_OBJECT_
RS_XML_copyNodesToDoc(USER_OBJECT_ s_node, USER_OBJECT_ s_doc, USER_OBJECT_ manageMemory)
{
xmlDocPtr doc;
xmlNodePtr node, ptr;
int len, i;
SEXP ans;
doc = (xmlDocPtr) R_ExternalPtrAddr(s_doc);
if(TYPEOF(s_node) == EXTPTRSXP) {
node = (xmlNodePtr) R_ExternalPtrAddr(s_node);
ptr = xmlDocCopyNode(node, doc, 1);
return(R_createXMLNodeRef(ptr, manageMemory));
}
len = Rf_length(s_node);
PROTECT(ans = NEW_LIST(len));
for(i = 0; i < len; i++) {
node = (xmlNodePtr) R_ExternalPtrAddr(VECTOR_ELT(s_node, i));
ptr = xmlDocCopyNode(node, doc, 1);
SET_VECTOR_ELT(ans, i, R_createXMLNodeRef(ptr, manageMemory));
}
UNPROTECT(1);
return(ans);
}
static SEXP
convertNodeSetToR(xmlNodeSetPtr obj, SEXP fun, int encoding, SEXP manageMemory)
{
SEXP ans, expr = NULL, arg = NULL, ref;
int i;
if(!obj)
return(NULL_USER_OBJECT);
PROTECT(ans = NEW_LIST(obj->nodeNr));
if(GET_LENGTH(fun) && (TYPEOF(fun) == CLOSXP || TYPEOF(fun) == BUILTINSXP)) {
PROTECT(expr = allocVector(LANGSXP, 2));
SETCAR(expr, fun);
arg = CDR(expr);
} else if(TYPEOF(fun) == LANGSXP) {
expr = fun;
arg = CDR(expr);
}
for(i = 0; i < obj->nodeNr; i++) {
xmlNodePtr el;
el = obj->nodeTab[i];
if(el->type == XML_ATTRIBUTE_NODE) {
#if 0
PROTECT(ref = mkString((el->children && el->children->content) ? XMLCHAR_TO_CHAR(el->children->content) : ""));
SET_NAMES(ref, mkString(el->name));
#else
PROTECT(ref = ScalarString(mkCharCE((el->children && el->children->content) ? XMLCHAR_TO_CHAR(el->children->content) : "", encoding)));
SET_NAMES(ref, ScalarString(mkCharCE(el->name, encoding)));
#endif
SET_CLASS(ref, mkString("XMLAttributeValue"));
UNPROTECT(1);
} else if(el->type == XML_NAMESPACE_DECL)
ref = R_createXMLNsRef((xmlNsPtr) el);
else
ref = R_createXMLNodeRef(el, manageMemory);
if(expr) {
PROTECT(ref);
SETCAR(arg, ref);
PROTECT(ref = Rf_eval(expr, R_GlobalEnv)); /*XXX do we want to catch errors here? Maybe to release the namespaces. */
SET_VECTOR_ELT(ans, i, ref);
UNPROTECT(2);
} else
SET_VECTOR_ELT(ans, i, ref);
}
if(expr) {
if(TYPEOF(fun) == CLOSXP || TYPEOF(fun) == BUILTINSXP)
UNPROTECT(1);
} else
SET_CLASS(ans, mkString("XMLNodeSet"));
UNPROTECT(1);
return(ans);
}
void
R_endBranch(RS_XMLParserData *rinfo,
const xmlChar * localname,
const xmlChar * prefix,
const xmlChar * URI)
{
if(rinfo->current) {
xmlNodePtr tmp;
xmlDocPtr doc = NULL;
tmp = rinfo->current;
if(tmp->parent == NULL) {
/* Call the function with the given node.*/
SEXP fun, args;
USER_OBJECT_ rnode;
if(rinfo->dynamicBranchFunction)
fun = rinfo->dynamicBranchFunction;
else {
fun = VECTOR_ELT(rinfo->branches, rinfo->branchIndex);
}
PROTECT(args = NEW_LIST(1));
if(tmp->doc == NULL) {
doc = xmlNewDoc("1.0");
initDocRefCounter(doc);
xmlDocSetRootElement(doc, tmp);
/* fprintf(stderr, "<r:createDoc addr='%p'/>\n", doc); */
numDocsCreated++;
}
SET_VECTOR_ELT(args, 0, rnode = R_createXMLNodeRef(tmp, rinfo->finalize));
RS_XML(invokeFunction)(fun, args, NULL, rinfo->ctx);
UNPROTECT(1);
/*
xmlFreeNode(rinfo->top);
rinfo->top = NULL;
*/
#if 0
fprintf(stderr, "Finishing branch for %s %s\n", tmp->name, tmp->properties->children->content);
#endif
/* if(rinfo->dynamicBranchFunction)
R_ReleaseObject(rinfo->dynamicBranchFunction);
*/
}
rinfo->current = rinfo->current->parent;
if(rinfo->current && (rinfo->current->type == XML_DOCUMENT_NODE || rinfo->current->type == XML_HTML_DOCUMENT_NODE))
rinfo->current = NULL;
}
}
