setGeneric("findXIncludeStartNodes",
function(doc, ...)
{
standardGeneric("findXIncludeStartNodes")
})
setMethod("findXIncludeStartNodes", "character",
function(doc, ...)
{
findXIncludeStartNodes(xmlParse(doc), ...)
})
setMethod("findXIncludeStartNodes", "XMLInternalDocument",
function(doc, ...)
{
findXIncludeStartNodes(xmlRoot(doc), ...)
})
setMethod("findXIncludeStartNodes", "XMLInternalElementNode",
function(doc, ...)
{
nodes = .Call("R_findXIncludeStartNodes", xmlRoot(doc), PACKAGE = "XML")
names(nodes) = sapply(nodes, xmlGetAttr, "href", NA)
nodes
})
findXInclude =
function(x, asNode = FALSE, recursive = FALSE)
{
while(!is.null(x)) {
tmp = getSiblingXIncludeStart(x, TRUE)
if(!is.null(tmp))
return(fixFindXInclude(tmp, asNode, recursive))
sib = x
if(is(sib, "XMLXIncludeStartNode"))
return(fixFindXInclude(sib, asNode, recursive)) # if(asNode) sib else xmlAttrs(sib))
x = xmlParent(x)
}
fixFindXInclude(x, asNode, recursive)
}
bad.findXInclude =
# This version just looks in the left sibling, not all siblings to the left.
function(x, asNode = FALSE, recursive = FALSE)
{
ans = NULL
while(!is.null(x)) {
prev = getSiblingXIncludeStart(x, FALSE)
if(inherits(prev, "XMLXIncludeStartNode")) {
ans = prev
break
}
x = xmlParent(x)
}
fixFindXInclude(ans, asNode, recursive)
}
fixFindXInclude =
function(ans, asNode = FALSE, recursive = FALSE)
{
if(is.null(ans))
return(NULL)
if(recursive) {
tmp = getXIncludePath(ans)
if(FALSE && grepl(sprintf("^(%s|http:|ftp:)", .Platform$file.sep), tmp))
tmp
else
sprintf("%s%s%s",
paste(dirname(unique(tmp)), collapse = .Platform$file.sep),
.Platform$file.sep,
xmlAttrs(ans))
} else
if(asNode) ans else xmlAttrs(ans)["href"]
}
getXIncludePath =
function(node)
{
x = xmlParent(node)
ans = character()
while(!is.null(x)) {
ans = c(ans, findXInclude(x))
prev = x
x = xmlParent(x)
}
c(docName(prev), ans)
}
getSiblingXIncludeStart =
function(x, asNode = FALSE)
{
sib = x
while(!is.null(sib)) {
if(inherits(sib, "XMLXIncludeEndNode"))
return(NULL)
if(inherits(sib, "XMLXIncludeStartNode"))
return(if(asNode) sib else xmlAttrs(sib))
sib <- getSibling(sib, FALSE)
}
NULL
}
getNodePosition =
function(x) {
if(is.list(x))
return(sapply(x, getNodePosition))
tmp = getNodeLocation(x)
sprintf("%s:%d", tmp$file[1], tmp$line)
}
getNodeLocation =
function(node, recursive = TRUE, fileOnly = FALSE)
{
if(is.list(node))
return(lapply(node, getNodeLocation, recursive, fileOnly))
fil = findXInclude(node, recursive = recursive)
if(is.null(fil))
fil = docName(node)
if(fileOnly)
fil[1]
else
list(file = fil, line = getLineNumber(node))
}
getLineNumber =
function(node, ...)
{
if(!is(node, "XMLInternalNode"))
stop("This must be an C-level/native/internal XML node, i.e. of class 'XMLInternalNode'. Got ", paste(class(node), collapse = ", "))
.Call("R_getLineNumber", node, PACKAGE = "XML")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.